* several fixes for Linux/PPC compilation

rtl/inc/objpas.inc

@@ -1,800 +1,807 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by the Free Pascal development team
-
-    This unit makes Free Pascal as much as possible Delphi compatible
-
-    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.
-
- **********************************************************************}
-
-{****************************************************************************
-                  Internal Routines called from the Compiler
-****************************************************************************}
-
-    { the reverse order of the parameters make code generation easier }
-    function fpc_do_is(aclass : tclass;aobject : tobject) : boolean;[public,alias: 'FPC_DO_IS']; {$ifdef hascompilerproc} compilerproc; {$endif}
-      begin
-         fpc_do_is:=assigned(aobject) and assigned(aclass) and
-           aobject.inheritsfrom(aclass);
-      end;
-
-
-    { the reverse order of the parameters make code generation easier }
-    function fpc_do_as(aclass : tclass;aobject : tobject): tobject;[public,alias: 'FPC_DO_AS']; {$ifdef hascompilerproc} compilerproc; {$endif}
-      begin
-         if assigned(aobject) and not(aobject.inheritsfrom(aclass)) then
-           handleerrorframe(219,get_frame);
-         result := aobject;
-      end;
-
-{$ifndef HASINTF}
-    { dummies for make cycle with 1.0.x }
-    procedure fpc_intf_decr_ref(var i: pointer);saveregisters;[public,alias: 'FPC_INTF_DECR_REF']; {$ifdef hascompilerproc} compilerproc; {$endif}
-      begin
-      end;
-
-    procedure fpc_intf_incr_ref(const i: pointer);saveregisters;[public,alias: 'FPC_INTF_INCR_REF']; {$ifdef hascompilerproc} compilerproc; {$endif}
-      begin
-      end;
-
-    procedure fpc_intf_assign(var D: pointer; const S: pointer);[public,alias: 'FPC_INTF_ASSIGN']; {$ifdef hascompilerproc} compilerproc; {$endif}
-      begin
-      end;
-
-    procedure fpc_intf_as(var D: pointer; const S: pointer; const iid: TGUID);[public,alias: 'FPC_INTF_AS']; {$ifdef hascompilerproc} compilerproc; {$endif}
-      begin
-      end;
-
-{$else HASINTF}
-
-    { interface helpers }
-    procedure fpc_intf_decr_ref(var i: pointer);saveregisters;[public,alias: 'FPC_INTF_DECR_REF']; {$ifdef hascompilerproc} compilerproc; {$endif}
-      begin
-        if assigned(i) then
-          IUnknown(i)._Release;
-        i:=nil;
-      end;
-
-    {$ifdef hascompilerproc}
-    { local declaration for intf_decr_ref for local access }
-    procedure intf_decr_ref(var i: pointer);saveregisters; [external name 'FPC_INTF_DECR_REF'];
-    {$endif hascompilerproc}
-
-
-    procedure fpc_intf_incr_ref(i: pointer);saveregisters;[public,alias: 'FPC_INTF_INCR_REF']; {$ifdef hascompilerproc} compilerproc; {$endif}
-      begin
-         if assigned(i) then
-           IUnknown(i)._AddRef;
-      end;
-
-    {$ifdef hascompilerproc}
-    { local declaration of intf_incr_ref for local access }
-    procedure intf_incr_ref(i: pointer);saveregisters; [external name 'FPC_INTF_INCR_REF'];
-    {$endif hascompilerproc}
-
-    procedure fpc_intf_assign(var D: pointer; const S: pointer);[public,alias: 'FPC_INTF_ASSIGN']; {$ifdef hascompilerproc} compilerproc; {$endif}
-      begin
-         if assigned(S) then
-           IUnknown(S)._AddRef;
-         if assigned(D) then
-           IUnknown(D)._Release;
-         D:=S;
-      end;
-
-    function fpc_intf_as(const S: pointer; const iid: TGUID): pointer;[public,alias: 'FPC_INTF_AS']; {$ifdef hascompilerproc} compilerproc; {$endif}
-      const
-        S_OK = 0;
-      var
-        tmpi: pointer; // _AddRef before _Release
-      begin
-        if assigned(S) then
-          begin
-             if IUnknown(S).QueryInterface(iid,tmpi)<>S_OK then
-               handleerror(219);
-             fpc_intf_as:=tmpi;
-          end
-        else
-          fpc_intf_as:=nil;
-      end;
-
-
-    function fpc_class_as_intf(const S: pointer; const iid: TGUID): pointer;[public,alias: 'FPC_CLASS_AS_INTF']; {$ifdef hascompilerproc} compilerproc; {$endif}
-      const
-        S_OK = 0;
-      var
-        tmpi: pointer; // _AddRef before _Release
-      begin
-        if assigned(S) then
-          begin
-             if not TObject(S).GetInterface(iid,tmpi) then
-               handleerror(219);
-             fpc_class_as_intf:=tmpi;
-          end
-        else
-          fpc_class_as_intf:=nil;
-      end;
-{$endif HASINTF}
-
-
-{****************************************************************************
-                               TOBJECT
-****************************************************************************}
-
-      constructor TObject.Create;
-
-        begin
-        end;
-
-      destructor TObject.Destroy;
-
-        begin
-        end;
-
-      procedure TObject.Free;
-
-        begin
-           // the call via self avoids a warning
-           if self<>nil then
-             self.destroy;
-        end;
-
-      class function TObject.InstanceSize : LongInt;
-
-        type
-           plongint = ^longint;
-
-        begin
-           { type of self is class of tobject => it points to the vmt }
-           { the size is saved at offset 0                            }
-           InstanceSize:=plongint(self)^;
-        end;
-
-      procedure InitInterfacePointers(objclass: tclass;instance : pointer);
-
-{$ifdef HASINTF}
-        var
-           intftable : pinterfacetable;
-           i : longint;
-        begin
-          if assigned(objclass.classparent) then
-            InitInterfacePointers(objclass.classparent,instance);
-          intftable:=objclass.getinterfacetable;
-          if assigned(intftable) then
-            for i:=0 to intftable^.EntryCount-1 do
-              ppointer(@(PChar(instance)[intftable^.Entries[i].IOffset]))^:=
-                pointer(intftable^.Entries[i].VTable);
-        end;
-{$else HASINTF}
-        begin
-        end;
-{$endif HASINTF}
-
-      class function TObject.InitInstance(instance : pointer) : tobject;
-
-        begin
-           fillchar(instance^,self.instancesize,0);
-           { insert VMT pointer into the new created memory area }
-           { (in class methods self contains the VMT!)           }
-           ppointer(instance)^:=pointer(self);
-{$ifdef HASINTF}
-           InitInterfacePointers(self,instance);
-{$endif HASINTF}
-           InitInstance:=TObject(Instance);
-        end;
-
-      class function TObject.ClassParent : tclass;
-
-        begin
-           { type of self is class of tobject => it points to the vmt }
-           { the parent vmt is saved at offset vmtParent              }
-           classparent:=pclass(pointer(self)+vmtParent)^;
-        end;
-
-      class function TObject.NewInstance : tobject;
-
-        var
-           p : pointer;
-
-        begin
-           getmem(p,instancesize);
-           if p <> nil then
-              InitInstance(p);
-           NewInstance:=TObject(p);
-        end;
-
-      procedure TObject.FreeInstance;
-
-        var
-           p : Pointer;
-
-        begin
-           CleanupInstance;
-
-           { self is a register, so we can't pass it call by reference }
-           p:=Pointer(Self);
-           FreeMem(p,InstanceSize);
-        end;
-
-      function TObject.ClassType : TClass;
-
-        begin
-           ClassType:=TClass(Pointer(Self)^)
-        end;
-
-      type
-         tmethodnamerec = packed record
-            name : pshortstring;
-            addr : pointer;
-         end;
-
-         tmethodnametable = packed record
-           count : dword;
-           entries : packed array[0..0] of tmethodnamerec;
-         end;
-
-         pmethodnametable =  ^tmethodnametable;
-
-      class function TObject.MethodAddress(const name : shortstring) : pointer;
-
-        var
-           UName : ShortString;
-           methodtable : pmethodnametable;
-           i : dword;
-           c : tclass;
-
-        begin
-           UName := UpCase(name);
-           c:=self;
-           while assigned(c) do
-             begin
-                methodtable:=pmethodnametable((Pointer(c)+vmtMethodTable)^);
-                if assigned(methodtable) then
-                  begin
-                     for i:=0 to methodtable^.count-1 do
-                       if UpCase(methodtable^.entries[i].name^)=UName then
-                         begin
-                            MethodAddress:=methodtable^.entries[i].addr;
-                            exit;
-                         end;
-                  end;
-                c:=c.ClassParent;
-             end;
-           MethodAddress:=nil;
-        end;
-
-
-      class function TObject.MethodName(address : pointer) : shortstring;
-        var
-           methodtable : pmethodnametable;
-           i : dword;
-           c : tclass;
-        begin
-           c:=self;
-           while assigned(c) do
-             begin
-                methodtable:=pmethodnametable((Pointer(c)+vmtMethodTable)^);
-                if assigned(methodtable) then
-                  begin
-                     for i:=0 to methodtable^.count-1 do
-                       if methodtable^.entries[i].addr=address then
-                         begin
-                            MethodName:=methodtable^.entries[i].name^;
-                            exit;
-                         end;
-                  end;
-                c:=c.ClassParent;
-             end;
-           MethodName:='';
-        end;
-
-
-      function TObject.FieldAddress(const name : shortstring) : pointer;
-        type
-           PFieldInfo = ^TFieldInfo;
-           TFieldInfo = packed record
-             FieldOffset: LongWord;
-             ClassTypeIndex: Word;
-             Name: ShortString;
-           end;
-
-           PFieldTable = ^TFieldTable;
-           TFieldTable = packed record
-             FieldCount: Word;
-             ClassTable: Pointer;
-             { Fields: array[Word] of TFieldInfo;  Elements have variant size! }
-           end;
-
-        var
-           UName: ShortString;
-           CurClassType: TClass;
-           FieldTable: PFieldTable;
-           FieldInfo: PFieldInfo;
-           i: Integer;
-
-        begin
-           if Length(name) > 0 then
-           begin
-             UName := UpCase(name);
-             CurClassType := ClassType;
-             while CurClassType <> nil do
-             begin
-               FieldTable := PFieldTable((Pointer(CurClassType) + vmtFieldTable)^);
-               if FieldTable <> nil then
-               begin
-                 FieldInfo := PFieldInfo(Pointer(FieldTable) + 6);
-                 for i := 0 to FieldTable^.FieldCount - 1 do
-                 begin
-                   if UpCase(FieldInfo^.Name) = UName then
-                   begin
-                     fieldaddress := Pointer(Self) + FieldInfo^.FieldOffset;
-                     exit;
-                   end;
-                   Inc(Pointer(FieldInfo), 7 + Length(FieldInfo^.Name));
-                 end;
-               end;
-               { Try again with the parent class type }
-               CurClassType := CurClassType.ClassParent;
-             end;
-           end;
-
-           fieldaddress:=nil;
-        end;
-
-      function TObject.SafeCallException(exceptobject : tobject;
-        exceptaddr : pointer) : longint;
-
-        begin
-           safecallexception:=0;
-        end;
-
-      class function TObject.ClassInfo : pointer;
-
-        begin
-           ClassInfo:=ppointer(Pointer(self)+vmtTypeInfo)^;
-        end;
-
-      class function TObject.ClassName : ShortString;
-
-        begin
-           ClassName:=PShortString((Pointer(Self)+vmtClassName)^)^;
-        end;
-
-      class function TObject.ClassNameIs(const name : string) : boolean;
-
-        begin
-           ClassNameIs:=Upcase(ClassName)=Upcase(name);
-        end;
-
-      class function TObject.InheritsFrom(aclass : TClass) : Boolean;
-
-        var
-           c : tclass;
-
-        begin
-           c:=self;
-           while assigned(c) do
-             begin
-                if c=aclass then
-                  begin
-                     InheritsFrom:=true;
-                     exit;
-                  end;
-                c:=c.ClassParent;
-             end;
-           InheritsFrom:=false;
-        end;
-
-      class function TObject.stringmessagetable : pstringmessagetable;
-
-        type
-           pdword = ^dword;
-
-        begin
-           stringmessagetable:=pstringmessagetable((pointer(Self)+vmtMsgStrPtr)^);
-        end;
-
-      type
-         tmessagehandler = procedure(var msg) of object;
-         tmessagehandlerrec = packed record
-            proc : pointer;
-            obj : pointer;
-         end;
-
-
-      procedure TObject.Dispatch(var message);
-
-        type
-           tmsgtable = record
-              index : dword;
-              method : pointer;
-           end;
-
-           pmsgtable = ^tmsgtable;
-
-           pdword = ^dword;
-
-        var
-           index : dword;
-           count,i : longint;
-           msgtable : pmsgtable;
-           p : pointer;
-           vmt : tclass;
-           msghandler : tmessagehandler;
-
-        begin
-           index:=dword(message);
-           vmt:=ClassType;
-           while assigned(vmt) do
-             begin
-                // See if we have messages at all in this class.
-                p:=pointer(vmt)+vmtDynamicTable;
-                If Assigned(p) and (Pdword(p)^<>0) then
-                  begin
-                  msgtable:=pmsgtable(pdword(P)^+4);
-                  count:=pdword(pdword(P)^)^;
-                  end
-                else
-                  Count:=0;
-                { later, we can implement a binary search here }
-                for i:=0 to count-1 do
-                  begin
-                     if index=msgtable[i].index then
-                       begin
-                          p:=msgtable[i].method;
-                          tmessagehandlerrec(msghandler).proc:=p;
-                          tmessagehandlerrec(msghandler).obj:=self;
-                          msghandler(message);
-                          { we don't need any longer the assembler
-                            solution
-                          asm
-                             pushl message
-                             pushl %esi
-                             movl p,%edi
-                             call *%edi
-                          end;
-                          }
-                          exit;
-                       end;
-                  end;
-                vmt:=vmt.ClassParent;
-             end;
-           DefaultHandler(message);
-        end;
-
-      procedure TObject.DispatchStr(var message);
-
-        type
-           pdword = ^dword;
-
-        var
-           name : shortstring;
-           count,i : longint;
-           msgstrtable : pmsgstrtable;
-           p : pointer;
-           vmt : tclass;
-           msghandler : tmessagehandler;
-
-        begin
-           name:=pshortstring(@message)^;
-           vmt:=ClassType;
-           while assigned(vmt) do
-             begin
-                p:=(pointer(vmt)+vmtMsgStrPtr);
-                If (P<>Nil) and (PDWord(P)^<>0) then
-                  begin
-                  count:=pdword(pdword(p)^)^;
-                  msgstrtable:=pmsgstrtable(pdword(P)^+4);
-                  end
-                else
-                  Count:=0;
-                { later, we can implement a binary search here }
-                for i:=0 to count-1 do
-                  begin
-                     if name=msgstrtable[i].name^ then
-                       begin
-                          p:=msgstrtable[i].method;
-                          tmessagehandlerrec(msghandler).proc:=p;
-                          tmessagehandlerrec(msghandler).obj:=self;
-                          msghandler(message);
-                          { we don't need any longer the assembler
-                            solution
-                          asm
-                             pushl message
-                             pushl %esi
-                             movl p,%edi
-                             call *%edi
-                          end;
-                          }
-                          exit;
-                       end;
-                  end;
-                vmt:=vmt.ClassParent;
-             end;
-           DefaultHandlerStr(message);
-        end;
-
-      procedure TObject.DefaultHandler(var message);
-
-        begin
-        end;
-
-      procedure TObject.DefaultHandlerStr(var message);
-
-        begin
-        end;
-
-      procedure TObject.CleanupInstance;
-
-        var
-           vmt : tclass;
-
-        begin
-           vmt:=ClassType;
-           while vmt<>nil do
-             begin
-                if Assigned(Pointer((Pointer(vmt)+vmtInitTable)^)) then
-                  int_finalize(Pointer(Self),Pointer((Pointer(vmt)+vmtInitTable)^));
-                vmt:=vmt.ClassParent;
-             end;
-        end;
-
-      procedure TObject.AfterConstruction;
-
-        begin
-        end;
-
-      procedure TObject.BeforeDestruction;
-
-        begin
-        end;
-
-{$ifdef HASINTF}
-      function IsGUIDEqual(const guid1, guid2: tguid): boolean;
-        begin
-          IsGUIDEqual:=
-            (guid1.D1=guid2.D1) and
-            (PDWORD(@guid1.D2)^=PDWORD(@guid2.D2)^) and
-            (PDWORD(@guid1.D4[0])^=PDWORD(@guid2.D4[0])^) and
-            (PDWORD(@guid1.D4[4])^=PDWORD(@guid2.D4[4])^);
-        end;
-
-      function TObject.getinterface(const iid : tguid;out obj) : boolean;
-        var
-          IEntry: pinterfaceentry;
-        begin
-          IEntry:=getinterfaceentry(iid);
-          if Assigned(IEntry) then begin
-            PDWORD(@obj)^:=DWORD(PDWORD(Self))+IEntry^.IOffset;
-            intf_incr_ref(pointer(obj)); { it must be an com interface }
-            getinterface:=True;
-          end
-          else begin
-            PDWORD(@Obj)^:=0;
-            getinterface:=False;
-          end;
-        end;
-
-      function TObject.getinterfacebystr(const iidstr : string;out obj) : boolean;
-        var
-          IEntry: pinterfaceentry;
-        begin
-          IEntry:=getinterfaceentrybystr(iidstr);
-          if Assigned(IEntry) then begin
-            PDWORD(@obj)^:=DWORD(PDWORD(Self))+IEntry^.IOffset;
-            if Assigned(IEntry^.iid) then { for Com interfaces }
-              intf_incr_ref(pointer(obj));
-            getinterfacebystr:=True;
-          end
-          else begin
-            PDWORD(@Obj)^:=0;
-            getinterfacebystr:=False;
-          end;
-        end;
-
-      class function TObject.getinterfaceentry(const iid : tguid) : pinterfaceentry;
-        var
-          i: integer;
-          intftable: pinterfacetable;
-          Res: pinterfaceentry;
-        begin
-          getinterfaceentry:=nil;
-          intftable:=getinterfacetable;
-          if assigned(intftable) then begin
-            i:=intftable^.EntryCount;
-            Res:=@intftable^.Entries[0];
-            while (i>0) and
-               not (assigned(Res^.iid) and IsGUIDEqual(Res^.iid^,iid)) do begin
-              inc(Res);
-              dec(i);
-            end;
-            if (i>0) then
-              getinterfaceentry:=Res;
-          end;
-        end;
-
-      class function TObject.getinterfaceentrybystr(const iidstr : string) : pinterfaceentry;
-        var
-          i: integer;
-          intftable: pinterfacetable;
-          Res: pinterfaceentry;
-        begin
-          getinterfaceentrybystr:=nil;
-          intftable:=getinterfacetable;
-          if assigned(intftable) then begin
-            i:=intftable^.EntryCount;
-            Res:=@intftable^.Entries[0];
-            while (i>0) and (Res^.iidstr^<>iidstr) do begin
-              inc(Res);
-              dec(i);
-            end;
-            if (i>0) then
-              getinterfaceentrybystr:=Res;
-          end;
-        end;
-
-      class function TObject.getinterfacetable : pinterfacetable;
-        begin
-          getinterfacetable:=pinterfacetable((pointer(Self)+vmtIntfTable)^);
-        end;
-
-{****************************************************************************
-                               TINTERFACEDOBJECT
-****************************************************************************}
-
-    function TInterfacedObject.QueryInterface(
-      const iid : tguid;out obj) : longint;stdcall;
-
-      begin
-         if getinterface(iid,obj) then
-           result:=0
-         else
-           result:=longint($80004002);
-      end;
-
-    function TInterfacedObject._AddRef : longint;stdcall;
-
-      begin
-         inclocked(frefcount);
-         _addref:=frefcount;
-      end;
-
-    function TInterfacedObject._Release : longint;stdcall;
-
-      begin
-         if declocked(frefcount) then
-           begin
-              destroy;
-              _Release:=0;
-           end
-         else
-           _Release:=frefcount;
-      end;
-
-    procedure TInterfacedObject.AfterConstruction;
-
-      begin
-         { we need to fix the refcount we forced in newinstance }
-         { further, it must be done in a thread safe way        }
-         declocked(frefcount);
-      end;
-
-    procedure TInterfacedObject.BeforeDestruction;
-
-      begin
-         if frefcount<>0 then
-           HandleError(204);
-      end;
-
-    class function TInterfacedObject.NewInstance : TObject;
-
-      begin
-         NewInstance:=inherited NewInstance;
-         TInterfacedObject(NewInstance).frefcount:=1;
-      end;
-
-{$endif HASINTF}
-
-{****************************************************************************
-                             Exception Support
-****************************************************************************}
-
-{$i except.inc}
-
-{****************************************************************************
-                                Initialize
-****************************************************************************}
-
-{
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by the Free Pascal development team
+
+    This unit makes Free Pascal as much as possible Delphi compatible
+
+    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.
+
+ **********************************************************************}
+
+{****************************************************************************
+                  Internal Routines called from the Compiler
+****************************************************************************}
+
+    { the reverse order of the parameters make code generation easier }
+    function fpc_do_is(aclass : tclass;aobject : tobject) : boolean;[public,alias: 'FPC_DO_IS']; {$ifdef hascompilerproc} compilerproc; {$endif}
+      begin
+         fpc_do_is:=assigned(aobject) and assigned(aclass) and
+           aobject.inheritsfrom(aclass);
+      end;
+
+
+    { the reverse order of the parameters make code generation easier }
+    function fpc_do_as(aclass : tclass;aobject : tobject): tobject;[public,alias: 'FPC_DO_AS']; {$ifdef hascompilerproc} compilerproc; {$endif}
+      begin
+         if assigned(aobject) and not(aobject.inheritsfrom(aclass)) then
+           handleerrorframe(219,get_frame);
+         result := aobject;
+      end;
+
+{$ifndef HASINTF}
+    { dummies for make cycle with 1.0.x }
+    procedure fpc_intf_decr_ref(var i: pointer);saveregisters;[public,alias: 'FPC_INTF_DECR_REF']; {$ifdef hascompilerproc} compilerproc; {$endif}
+      begin
+      end;
+
+    procedure fpc_intf_incr_ref(i: pointer);saveregisters;[public,alias: 'FPC_INTF_INCR_REF']; {$ifdef hascompilerproc} compilerproc; {$endif}
+      begin
+      end;
+
+    procedure fpc_intf_assign(var D: pointer; const S: pointer);[public,alias: 'FPC_INTF_ASSIGN']; {$ifdef hascompilerproc} compilerproc; {$endif}
+      begin
+      end;
+
+    function fpc_intf_as(const S: pointer; const iid: TGUID): pointer;[public,alias: 'FPC_INTF_AS']; {$ifdef hascompilerproc} compilerproc; {$endif}
+      begin
+      end;
+
+    function fpc_class_as_intf(const S: pointer; const iid: TGUID): pointer;[public,alias: 'FPC_CLASS_AS_INTF']; {$ifdef hascompilerproc} compilerproc; {$endif}
+      begin
+      end;
+
+{$else HASINTF}
+
+    { interface helpers }
+    procedure fpc_intf_decr_ref(var i: pointer);saveregisters;[public,alias: 'FPC_INTF_DECR_REF']; {$ifdef hascompilerproc} compilerproc; {$endif}
+      begin
+        if assigned(i) then
+          IUnknown(i)._Release;
+        i:=nil;
+      end;
+
+    {$ifdef hascompilerproc}
+    { local declaration for intf_decr_ref for local access }
+    procedure intf_decr_ref(var i: pointer);saveregisters; [external name 'FPC_INTF_DECR_REF'];
+    {$endif hascompilerproc}
+
+
+    procedure fpc_intf_incr_ref(i: pointer);saveregisters;[public,alias: 'FPC_INTF_INCR_REF']; {$ifdef hascompilerproc} compilerproc; {$endif}
+      begin
+         if assigned(i) then
+           IUnknown(i)._AddRef;
+      end;
+
+    {$ifdef hascompilerproc}
+    { local declaration of intf_incr_ref for local access }
+    procedure intf_incr_ref(i: pointer);saveregisters; [external name 'FPC_INTF_INCR_REF'];
+    {$endif hascompilerproc}
+
+    procedure fpc_intf_assign(var D: pointer; const S: pointer);[public,alias: 'FPC_INTF_ASSIGN']; {$ifdef hascompilerproc} compilerproc; {$endif}
+      begin
+         if assigned(S) then
+           IUnknown(S)._AddRef;
+         if assigned(D) then
+           IUnknown(D)._Release;
+         D:=S;
+      end;
+
+    function fpc_intf_as(const S: pointer; const iid: TGUID): pointer;[public,alias: 'FPC_INTF_AS']; {$ifdef hascompilerproc} compilerproc; {$endif}
+      const
+        S_OK = 0;
+      var
+        tmpi: pointer; // _AddRef before _Release
+      begin
+        if assigned(S) then
+          begin
+             if IUnknown(S).QueryInterface(iid,tmpi)<>S_OK then
+               handleerror(219);
+             fpc_intf_as:=tmpi;
+          end
+        else
+          fpc_intf_as:=nil;
+      end;
+
+
+    function fpc_class_as_intf(const S: pointer; const iid: TGUID): pointer;[public,alias: 'FPC_CLASS_AS_INTF']; {$ifdef hascompilerproc} compilerproc; {$endif}
+      const
+        S_OK = 0;
+      var
+        tmpi: pointer; // _AddRef before _Release
+      begin
+        if assigned(S) then
+          begin
+             if not TObject(S).GetInterface(iid,tmpi) then
+               handleerror(219);
+             fpc_class_as_intf:=tmpi;
+          end
+        else
+          fpc_class_as_intf:=nil;
+      end;
+{$endif HASINTF}
+
+
+{****************************************************************************
+                               TOBJECT
+****************************************************************************}
+
+      constructor TObject.Create;
+
+        begin
+        end;
+
+      destructor TObject.Destroy;
+
+        begin
+        end;
+
+      procedure TObject.Free;
+
+        begin
+           // the call via self avoids a warning
+           if self<>nil then
+             self.destroy;
+        end;
+
+      class function TObject.InstanceSize : LongInt;
+
+        type
+           plongint = ^longint;
+
+        begin
+           { type of self is class of tobject => it points to the vmt }
+           { the size is saved at offset 0                            }
+           InstanceSize:=plongint(self)^;
+        end;
+
+      procedure InitInterfacePointers(objclass: tclass;instance : pointer);
+
+{$ifdef HASINTF}
+        var
+           intftable : pinterfacetable;
+           i : longint;
+        begin
+          if assigned(objclass.classparent) then
+            InitInterfacePointers(objclass.classparent,instance);
+          intftable:=objclass.getinterfacetable;
+          if assigned(intftable) then
+            for i:=0 to intftable^.EntryCount-1 do
+              ppointer(@(PChar(instance)[intftable^.Entries[i].IOffset]))^:=
+                pointer(intftable^.Entries[i].VTable);
+        end;
+{$else HASINTF}
+        begin
+        end;
+{$endif HASINTF}
+
+      class function TObject.InitInstance(instance : pointer) : tobject;
+
+        begin
+           fillchar(instance^,self.instancesize,0);
+           { insert VMT pointer into the new created memory area }
+           { (in class methods self contains the VMT!)           }
+           ppointer(instance)^:=pointer(self);
+{$ifdef HASINTF}
+           InitInterfacePointers(self,instance);
+{$endif HASINTF}
+           InitInstance:=TObject(Instance);
+        end;
+
+      class function TObject.ClassParent : tclass;
+
+        begin
+           { type of self is class of tobject => it points to the vmt }
+           { the parent vmt is saved at offset vmtParent              }
+           classparent:=pclass(pointer(self)+vmtParent)^;
+        end;
+
+      class function TObject.NewInstance : tobject;
+
+        var
+           p : pointer;
+
+        begin
+           getmem(p,instancesize);
+           if p <> nil then
+              InitInstance(p);
+           NewInstance:=TObject(p);
+        end;
+
+      procedure TObject.FreeInstance;
+
+        var
+           p : Pointer;
+
+        begin
+           CleanupInstance;
+
+           { self is a register, so we can't pass it call by reference }
+           p:=Pointer(Self);
+           FreeMem(p,InstanceSize);
+        end;
+
+      function TObject.ClassType : TClass;
+
+        begin
+           ClassType:=TClass(Pointer(Self)^)
+        end;
+
+      type
+         tmethodnamerec = packed record
+            name : pshortstring;
+            addr : pointer;
+         end;
+
+         tmethodnametable = packed record
+           count : dword;
+           entries : packed array[0..0] of tmethodnamerec;
+         end;
+
+         pmethodnametable =  ^tmethodnametable;
+
+      class function TObject.MethodAddress(const name : shortstring) : pointer;
+
+        var
+           UName : ShortString;
+           methodtable : pmethodnametable;
+           i : dword;
+           c : tclass;
+
+        begin
+           UName := UpCase(name);
+           c:=self;
+           while assigned(c) do
+             begin
+                methodtable:=pmethodnametable((Pointer(c)+vmtMethodTable)^);
+                if assigned(methodtable) then
+                  begin
+                     for i:=0 to methodtable^.count-1 do
+                       if UpCase(methodtable^.entries[i].name^)=UName then
+                         begin
+                            MethodAddress:=methodtable^.entries[i].addr;
+                            exit;
+                         end;
+                  end;
+                c:=c.ClassParent;
+             end;
+           MethodAddress:=nil;
+        end;
+
+
+      class function TObject.MethodName(address : pointer) : shortstring;
+        var
+           methodtable : pmethodnametable;
+           i : dword;
+           c : tclass;
+        begin
+           c:=self;
+           while assigned(c) do
+             begin
+                methodtable:=pmethodnametable((Pointer(c)+vmtMethodTable)^);
+                if assigned(methodtable) then
+                  begin
+                     for i:=0 to methodtable^.count-1 do
+                       if methodtable^.entries[i].addr=address then
+                         begin
+                            MethodName:=methodtable^.entries[i].name^;
+                            exit;
+                         end;
+                  end;
+                c:=c.ClassParent;
+             end;
+           MethodName:='';
+        end;
+
+
+      function TObject.FieldAddress(const name : shortstring) : pointer;
+        type
+           PFieldInfo = ^TFieldInfo;
+           TFieldInfo = packed record
+             FieldOffset: LongWord;
+             ClassTypeIndex: Word;
+             Name: ShortString;
+           end;
+
+           PFieldTable = ^TFieldTable;
+           TFieldTable = packed record
+             FieldCount: Word;
+             ClassTable: Pointer;
+             { Fields: array[Word] of TFieldInfo;  Elements have variant size! }
+           end;
+
+        var
+           UName: ShortString;
+           CurClassType: TClass;
+           FieldTable: PFieldTable;
+           FieldInfo: PFieldInfo;
+           i: Integer;
+
+        begin
+           if Length(name) > 0 then
+           begin
+             UName := UpCase(name);
+             CurClassType := ClassType;
+             while CurClassType <> nil do
+             begin
+               FieldTable := PFieldTable((Pointer(CurClassType) + vmtFieldTable)^);
+               if FieldTable <> nil then
+               begin
+                 FieldInfo := PFieldInfo(Pointer(FieldTable) + 6);
+                 for i := 0 to FieldTable^.FieldCount - 1 do
+                 begin
+                   if UpCase(FieldInfo^.Name) = UName then
+                   begin
+                     fieldaddress := Pointer(Self) + FieldInfo^.FieldOffset;
+                     exit;
+                   end;
+                   Inc(Pointer(FieldInfo), 7 + Length(FieldInfo^.Name));
+                 end;
+               end;
+               { Try again with the parent class type }
+               CurClassType := CurClassType.ClassParent;
+             end;
+           end;
+
+           fieldaddress:=nil;
+        end;
+
+      function TObject.SafeCallException(exceptobject : tobject;
+        exceptaddr : pointer) : longint;
+
+        begin
+           safecallexception:=0;
+        end;
+
+      class function TObject.ClassInfo : pointer;
+
+        begin
+           ClassInfo:=ppointer(Pointer(self)+vmtTypeInfo)^;
+        end;
+
+      class function TObject.ClassName : ShortString;
+
+        begin
+           ClassName:=PShortString((Pointer(Self)+vmtClassName)^)^;
+        end;
+
+      class function TObject.ClassNameIs(const name : string) : boolean;
+
+        begin
+           ClassNameIs:=Upcase(ClassName)=Upcase(name);
+        end;
+
+      class function TObject.InheritsFrom(aclass : TClass) : Boolean;
+
+        var
+           c : tclass;
+
+        begin
+           c:=self;
+           while assigned(c) do
+             begin
+                if c=aclass then
+                  begin
+                     InheritsFrom:=true;
+                     exit;
+                  end;
+                c:=c.ClassParent;
+             end;
+           InheritsFrom:=false;
+        end;
+
+      class function TObject.stringmessagetable : pstringmessagetable;
+
+        type
+           pdword = ^dword;
+
+        begin
+           stringmessagetable:=pstringmessagetable((pointer(Self)+vmtMsgStrPtr)^);
+        end;
+
+      type
+         tmessagehandler = procedure(var msg) of object;
+         tmessagehandlerrec = packed record
+            proc : pointer;
+            obj : pointer;
+         end;
+
+
+      procedure TObject.Dispatch(var message);
+
+        type
+           tmsgtable = record
+              index : dword;
+              method : pointer;
+           end;
+
+           pmsgtable = ^tmsgtable;
+
+           pdword = ^dword;
+
+        var
+           index : dword;
+           count,i : longint;
+           msgtable : pmsgtable;
+           p : pointer;
+           vmt : tclass;
+           msghandler : tmessagehandler;
+
+        begin
+           index:=dword(message);
+           vmt:=ClassType;
+           while assigned(vmt) do
+             begin
+                // See if we have messages at all in this class.
+                p:=pointer(vmt)+vmtDynamicTable;
+                If Assigned(p) and (Pdword(p)^<>0) then
+                  begin
+                  msgtable:=pmsgtable(pdword(P)^+4);
+                  count:=pdword(pdword(P)^)^;
+                  end
+                else
+                  Count:=0;
+                { later, we can implement a binary search here }
+                for i:=0 to count-1 do
+                  begin
+                     if index=msgtable[i].index then
+                       begin
+                          p:=msgtable[i].method;
+                          tmessagehandlerrec(msghandler).proc:=p;
+                          tmessagehandlerrec(msghandler).obj:=self;
+                          msghandler(message);
+                          { we don't need any longer the assembler
+                            solution
+                          asm
+                             pushl message
+                             pushl %esi
+                             movl p,%edi
+                             call *%edi
+                          end;
+                          }
+                          exit;
+                       end;
+                  end;
+                vmt:=vmt.ClassParent;
+             end;
+           DefaultHandler(message);
+        end;
+
+      procedure TObject.DispatchStr(var message);
+
+        type
+           pdword = ^dword;
+
+        var
+           name : shortstring;
+           count,i : longint;
+           msgstrtable : pmsgstrtable;
+           p : pointer;
+           vmt : tclass;
+           msghandler : tmessagehandler;
+
+        begin
+           name:=pshortstring(@message)^;
+           vmt:=ClassType;
+           while assigned(vmt) do
+             begin
+                p:=(pointer(vmt)+vmtMsgStrPtr);
+                If (P<>Nil) and (PDWord(P)^<>0) then
+                  begin
+                  count:=pdword(pdword(p)^)^;
+                  msgstrtable:=pmsgstrtable(pdword(P)^+4);
+                  end
+                else
+                  Count:=0;
+                { later, we can implement a binary search here }
+                for i:=0 to count-1 do
+                  begin
+                     if name=msgstrtable[i].name^ then
+                       begin
+                          p:=msgstrtable[i].method;
+                          tmessagehandlerrec(msghandler).proc:=p;
+                          tmessagehandlerrec(msghandler).obj:=self;
+                          msghandler(message);
+                          { we don't need any longer the assembler
+                            solution
+                          asm
+                             pushl message
+                             pushl %esi
+                             movl p,%edi
+                             call *%edi
+                          end;
+                          }
+                          exit;
+                       end;
+                  end;
+                vmt:=vmt.ClassParent;
+             end;
+           DefaultHandlerStr(message);
+        end;
+
+      procedure TObject.DefaultHandler(var message);
+
+        begin
+        end;
+
+      procedure TObject.DefaultHandlerStr(var message);
+
+        begin
+        end;
+
+      procedure TObject.CleanupInstance;
+
+        var
+           vmt : tclass;
+
+        begin
+           vmt:=ClassType;
+           while vmt<>nil do
+             begin
+                if Assigned(Pointer((Pointer(vmt)+vmtInitTable)^)) then
+                  int_finalize(Pointer(Self),Pointer((Pointer(vmt)+vmtInitTable)^));
+                vmt:=vmt.ClassParent;
+             end;
+        end;
+
+      procedure TObject.AfterConstruction;
+
+        begin
+        end;
+
+      procedure TObject.BeforeDestruction;
+
+        begin
+        end;
+
+{$ifdef HASINTF}
+      function IsGUIDEqual(const guid1, guid2: tguid): boolean;
+        begin
+          IsGUIDEqual:=
+            (guid1.D1=guid2.D1) and
+            (PDWORD(@guid1.D2)^=PDWORD(@guid2.D2)^) and
+            (PDWORD(@guid1.D4[0])^=PDWORD(@guid2.D4[0])^) and
+            (PDWORD(@guid1.D4[4])^=PDWORD(@guid2.D4[4])^);
+        end;
+
+      function TObject.getinterface(const iid : tguid;out obj) : boolean;
+        var
+          IEntry: pinterfaceentry;
+        begin
+          IEntry:=getinterfaceentry(iid);
+          if Assigned(IEntry) then begin
+            PDWORD(@obj)^:=DWORD(PDWORD(Self))+IEntry^.IOffset;
+            intf_incr_ref(pointer(obj)); { it must be an com interface }
+            getinterface:=True;
+          end
+          else begin
+            PDWORD(@Obj)^:=0;
+            getinterface:=False;
+          end;
+        end;
+
+      function TObject.getinterfacebystr(const iidstr : string;out obj) : boolean;
+        var
+          IEntry: pinterfaceentry;
+        begin
+          IEntry:=getinterfaceentrybystr(iidstr);
+          if Assigned(IEntry) then begin
+            PDWORD(@obj)^:=DWORD(PDWORD(Self))+IEntry^.IOffset;
+            if Assigned(IEntry^.iid) then { for Com interfaces }
+              intf_incr_ref(pointer(obj));
+            getinterfacebystr:=True;
+          end
+          else begin
+            PDWORD(@Obj)^:=0;
+            getinterfacebystr:=False;
+          end;
+        end;
+
+      class function TObject.getinterfaceentry(const iid : tguid) : pinterfaceentry;
+        var
+          i: integer;
+          intftable: pinterfacetable;
+          Res: pinterfaceentry;
+        begin
+          getinterfaceentry:=nil;
+          intftable:=getinterfacetable;
+          if assigned(intftable) then begin
+            i:=intftable^.EntryCount;
+            Res:=@intftable^.Entries[0];
+            while (i>0) and
+               not (assigned(Res^.iid) and IsGUIDEqual(Res^.iid^,iid)) do begin
+              inc(Res);
+              dec(i);
+            end;
+            if (i>0) then
+              getinterfaceentry:=Res;
+          end;
+        end;
+
+      class function TObject.getinterfaceentrybystr(const iidstr : string) : pinterfaceentry;
+        var
+          i: integer;
+          intftable: pinterfacetable;
+          Res: pinterfaceentry;
+        begin
+          getinterfaceentrybystr:=nil;
+          intftable:=getinterfacetable;
+          if assigned(intftable) then begin
+            i:=intftable^.EntryCount;
+            Res:=@intftable^.Entries[0];
+            while (i>0) and (Res^.iidstr^<>iidstr) do begin
+              inc(Res);
+              dec(i);
+            end;
+            if (i>0) then
+              getinterfaceentrybystr:=Res;
+          end;
+        end;
+
+      class function TObject.getinterfacetable : pinterfacetable;
+        begin
+          getinterfacetable:=pinterfacetable((pointer(Self)+vmtIntfTable)^);
+        end;
+
+{****************************************************************************
+                               TINTERFACEDOBJECT
+****************************************************************************}
+
+    function TInterfacedObject.QueryInterface(
+      const iid : tguid;out obj) : longint;stdcall;
+
+      begin
+         if getinterface(iid,obj) then
+           result:=0
+         else
+           result:=longint($80004002);
+      end;
+
+    function TInterfacedObject._AddRef : longint;stdcall;
+
+      begin
+         inclocked(frefcount);
+         _addref:=frefcount;
+      end;
+
+    function TInterfacedObject._Release : longint;stdcall;
+
+      begin
+         if declocked(frefcount) then
+           begin
+              destroy;
+              _Release:=0;
+           end
+         else
+           _Release:=frefcount;
+      end;
+
+    procedure TInterfacedObject.AfterConstruction;
+
+      begin
+         { we need to fix the refcount we forced in newinstance }
+         { further, it must be done in a thread safe way        }
+         declocked(frefcount);
+      end;
+
+    procedure TInterfacedObject.BeforeDestruction;
+
+      begin
+         if frefcount<>0 then
+           HandleError(204);
+      end;
+
+    class function TInterfacedObject.NewInstance : TObject;
+
+      begin
+         NewInstance:=inherited NewInstance;
+         TInterfacedObject(NewInstance).frefcount:=1;
+      end;
+
+{$endif HASINTF}
+
+{****************************************************************************
+                             Exception Support
+****************************************************************************}
+
+{$i except.inc}
+
+{****************************************************************************
+                                Initialize
+****************************************************************************}
+
+{
   $Log$
-  Revision 1.24  2002-08-20 18:24:06  jonas
-    * interface "as" helpers converted from procedures to functions
-
-  Revision 1.23  2002/07/30 17:29:19  florian
-    * interface helpers for 1.1 compilers without interface support fixed
-
-  Revision 1.22  2002/07/01 16:29:05  peter
-    * sLineBreak changed to normal constant like Kylix
-
-  Revision 1.21  2002/04/26 15:19:05  peter
-    * use saveregisters for incr routines, saves also problems with
-      the optimizer
-
-  Revision 1.20  2002/04/25 20:14:57  peter
-    * updated compilerprocs
-    * incr ref count has now a value argument instead of var
-
-  Revision 1.19  2002/03/30 14:52:59  carl
-  * don't crash everything if the class allocation failed
-
-  Revision 1.18  2001/12/26 21:03:56  peter
-    * merged fixes from 1.0.x
-
-  Revision 1.17  2001/09/29 21:32:47  jonas
-    * almost all second pass typeconvnode helpers are now processor independent
-    * fixed converting boolean to int64/qword
-    * fixed register allocation bugs which could cause internalerror 10
-    * isnode and asnode are completely processor indepent now as well
-    * fpc_do_as now returns its class argument (necessary to be able to use it
-      properly with compilerproc)
-
-  Revision 1.16  2001/08/01 15:00:10  jonas
-    + "compproc" helpers
-    * renamed several helpers so that their name is the same as their
-      "public alias", which should facilitate the conversion of processor
-      specific code in the code generator to processor independent code
-    * some small fixes to the val_ansistring and val_widestring helpers
-      (always immediately exit if the source string is longer than 255
-       chars)
-    * fixed fpc_dynarray_high and fpc_dynarray_length if the dynarray is
-      still nil (used to crash, now return resp -1 and 0)
-
-  Revision 1.15  2001/05/27 14:28:44  florian
-    + made the ref. couting MT safe
-
-  Revision 1.14  2001/04/13 22:30:04  peter
-    * remove warnings
-
-  Revision 1.13  2000/12/20 21:38:23  florian
-    * is-operator fixed
-
-  Revision 1.12  2000/11/12 23:23:34  florian
-    * interfaces are basically running
-
-  Revision 1.11  2000/11/09 17:50:12  florian
-    * Finalize to int_finalize renamed
-
-  Revision 1.10  2000/11/07 23:42:21  florian
-    + AfterConstruction and BeforeDestruction implemented
-    + TInterfacedObject implemented
-
-  Revision 1.9  2000/11/06 22:03:12  florian
-    * another fix
-
-  Revision 1.8  2000/11/06 21:53:38  florian
-    * another fix for interfaces
-
-  Revision 1.7  2000/11/06 21:35:59  peter
-    * removed some warnings
-
-  Revision 1.6  2000/11/06 20:34:24  peter
-    * changed ver1_0 defines to temporary defs
-
-  Revision 1.5  2000/11/04 17:52:46  florian
-    * fixed linker errors
-
-  Revision 1.4  2000/11/04 16:29:54  florian
-    + interfaces support
-
-  Revision 1.3  2000/07/22 14:52:01  sg
-  * Resolved CVS conflicts for TObject.MethodAddress patch
-
-  Revision 1.1.2.1  2000/07/22 14:46:57  sg
-  * Made TObject.MethodAddress case independent
-}
+  Revision 1.25  2002-08-31 13:11:11  florian
+    * several fixes for Linux/PPC compilation
+
+  Revision 1.24  2002/08/20 18:24:06  jonas
+    * interface "as" helpers converted from procedures to functions
+
+  Revision 1.23  2002/07/30 17:29:19  florian
+    * interface helpers for 1.1 compilers without interface support fixed
+
+  Revision 1.22  2002/07/01 16:29:05  peter
+    * sLineBreak changed to normal constant like Kylix
+
+  Revision 1.21  2002/04/26 15:19:05  peter
+    * use saveregisters for incr routines, saves also problems with
+      the optimizer
+
+  Revision 1.20  2002/04/25 20:14:57  peter
+    * updated compilerprocs
+    * incr ref count has now a value argument instead of var
+
+  Revision 1.19  2002/03/30 14:52:59  carl
+  * don't crash everything if the class allocation failed
+
+  Revision 1.18  2001/12/26 21:03:56  peter
+    * merged fixes from 1.0.x
+
+  Revision 1.17  2001/09/29 21:32:47  jonas
+    * almost all second pass typeconvnode helpers are now processor independent
+    * fixed converting boolean to int64/qword
+    * fixed register allocation bugs which could cause internalerror 10
+    * isnode and asnode are completely processor indepent now as well
+    * fpc_do_as now returns its class argument (necessary to be able to use it
+      properly with compilerproc)
+
+  Revision 1.16  2001/08/01 15:00:10  jonas
+    + "compproc" helpers
+    * renamed several helpers so that their name is the same as their
+      "public alias", which should facilitate the conversion of processor
+      specific code in the code generator to processor independent code
+    * some small fixes to the val_ansistring and val_widestring helpers
+      (always immediately exit if the source string is longer than 255
+       chars)
+    * fixed fpc_dynarray_high and fpc_dynarray_length if the dynarray is
+      still nil (used to crash, now return resp -1 and 0)
+
+  Revision 1.15  2001/05/27 14:28:44  florian
+    + made the ref. couting MT safe
+
+  Revision 1.14  2001/04/13 22:30:04  peter
+    * remove warnings
+
+  Revision 1.13  2000/12/20 21:38:23  florian
+    * is-operator fixed
+
+  Revision 1.12  2000/11/12 23:23:34  florian
+    * interfaces are basically running
+
+  Revision 1.11  2000/11/09 17:50:12  florian
+    * Finalize to int_finalize renamed
+
+  Revision 1.10  2000/11/07 23:42:21  florian
+    + AfterConstruction and BeforeDestruction implemented
+    + TInterfacedObject implemented
+
+  Revision 1.9  2000/11/06 22:03:12  florian
+    * another fix
+
+  Revision 1.8  2000/11/06 21:53:38  florian
+    * another fix for interfaces
+
+  Revision 1.7  2000/11/06 21:35:59  peter
+    * removed some warnings
+
+  Revision 1.6  2000/11/06 20:34:24  peter
+    * changed ver1_0 defines to temporary defs
+
+  Revision 1.5  2000/11/04 17:52:46  florian
+    * fixed linker errors
+
+  Revision 1.4  2000/11/04 16:29:54  florian
+    + interfaces support
+
+  Revision 1.3  2000/07/22 14:52:01  sg
+  * Resolved CVS conflicts for TObject.MethodAddress patch
+
+  Revision 1.1.2.1  2000/07/22 14:46:57  sg
+  * Made TObject.MethodAddress case independent
+}

rtl/linux/powerpc/prt0.as

@@ -20,14 +20,14 @@
 	.section ".text"
 _start:
  	/* Save the stack pointer, in case we're statically linked under Linux.  */
-	mr	r9,r1
+	mr	9,1
 	/* Set up an initial stack frame, and clear the LR.  */
-	clrrwi	r1,r1,4
-	li	r0,0
-	stwu	r1,-16(r1)
-	mtlr	r0
-	stw	r0,0(r1)
-	b	PASCALMAIN
+	clrrwi	1,1,4
+	li	0,0
+	stwu	1,-16(1)
+	mtlr	0
+	stw	0,0(1)
+	bl	PASCALMAIN
 	
 	/* Define a symbol for the first piece of initialized data.  */
 	.section ".data"
@@ -41,7 +41,10 @@ ___fpc_brk_addr:
         .long   0
 /*
   $Log$
-  Revision 1.3  2002-08-19 21:19:15  florian
+  Revision 1.4  2002-08-31 13:11:11  florian
+    * several fixes for Linux/PPC compilation
+
+  Revision 1.3  2002/08/19 21:19:15  florian
     * small fixes
 
   Revision 1.2  2002/07/26 17:09:44  florian

rtl/powerpc/powerpc.inc

@@ -1,1008 +1,1011 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 2000-2001 by the Free Pascal development team.
-
-    Portions Copyright (c) 2000 by Casey Duncan ([email protected])
-
-    Processor dependent implementation for the system unit for
-    PowerPC
-
-    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.
-
- **********************************************************************}
-
-
-{****************************************************************************
-                           PowerPC specific stuff
-****************************************************************************}
-
-{ This function is never called directly, it's a dummy to hold the register save/
-  load subroutines
-}
-procedure saverestorereg;assembler;
-asm
-{ exit }
-.global _restfpr_14_x
-_restfpr_14_x:  lfd     f14, -144(r11)
-.global _restfpr_15_x
-_restfpr_15_x:  lfd     f15, -136(r11)
-.global _restfpr_16_x
-_restfpr_16_x:  lfd     f16, -128(r11)
-.global _restfpr_17_x
-_restfpr_17_x:  lfd     f17, -120(r11)
-.global _restfpr_18_x
-_restfpr_18_x:  lfd     f18, -112(r11)
-.global _restfpr_19_x
-_restfpr_19_x:  lfd     f19, -104(r11)
-.global _restfpr_20_x
-_restfpr_20_x:  lfd     f20, -96(r11)
-.global _restfpr_21_x
-_restfpr_21_x:  lfd     f21, -88(r11)
-.global _restfpr_22_x
-_restfpr_22_x:  lfd     f22, -80(r11)
-.global _restfpr_23_x
-_restfpr_23_x:  lfd     f23, -72(r11)
-.global _restfpr_24_x
-_restfpr_24_x:  lfd     f24, -64(r11)
-.global _restfpr_25_x
-_restfpr_25_x:  lfd     f25, -56(r11)
-.global _restfpr_26_x
-_restfpr_26_x:  lfd     f26, -48(r11)
-.global _restfpr_27_x
-_restfpr_27_x:  lfd     f27, -40(r11)
-.global _restfpr_28_x
-_restfpr_28_x:  lfd     f28, -32(r11)
-.global _restfpr_29_x
-_restfpr_29_x:  lfd     f29, -24(r11)
-.global _restfpr_30_x
-_restfpr_30_x:  lfd     f30, -16(r11)
-.global _restfpr_31_x
-_restfpr_31_x:  lwz     r0, 4(r11)
-                lfd     f31, -8(r11)
-                mtlr    r0
-                ori     r1, r11, 0
-                blr
-
-{ exit with restoring lr }
-.global _restfpr_14_l
-_restfpr_14_l:  lfd     f14, -144(r11)
-.global _restfpr_15_l
-_restfpr_15_l:  lfd     f15, -136(r11)
-.global _restfpr_16_l
-_restfpr_16_l:  lfd     f16, -128(r11)
-.global _restfpr_17_l
-_restfpr_17_l:  lfd     f17, -120(r11)
-.global _restfpr_18_l
-_restfpr_18_l:  lfd     f18, -112(r11)
-.global _restfpr_19_l
-_restfpr_19_l:  lfd     f19, -104(r11)
-.global _restfpr_20_l
-_restfpr_20_l:  lfd     f20, -96(r11)
-.global _restfpr_21_l
-_restfpr_21_l:  lfd     f21, -88(r11)
-.global _restfpr_22_l
-_restfpr_22_l:  lfd     f22, -80(r11)
-.global _restfpr_23_l
-_restfpr_23_l:  lfd     f23, -72(r11)
-.global _restfpr_24_l
-_restfpr_24_l:  lfd     f24, -64(r11)
-.global _restfpr_25_l
-_restfpr_25_l:  lfd     f25, -56(r11)
-.global _restfpr_26_l
-_restfpr_26_l:  lfd     f26, -48(r11)
-.global _restfpr_27_l
-_restfpr_27_l:  lfd     f27, -40(r11)
-.global _restfpr_28_l
-_restfpr_28_l:  lfd     f28, -32(r11)
-.global _restfpr_29_l
-_restfpr_29_l:  lfd     f29, -24(r11)
-.global _restfpr_30_l
-_restfpr_30_l:  lfd     f30, -16(r11)
-.global _restfpr_31_l
-_restfpr_31_l:  lwz     r0, 4(r11)
-                lfd     f31, -8(r11)
-                mtlr    r0
-                ori     r1, r11, 0
-                blr
-end;
-
-
-{****************************************************************************
-                                Move / Fill
-****************************************************************************}
-
-{$define FPC_SYSTEM_HAS_MOVE}
-
-procedure Move(var source;var dest;count:longint);assembler;
-asm
-          {  count <= 0 ?  }
-          cmpwi   cr0,r5,0
-          {  check if we have to do the move backwards because of overlap  }
-          sub     r10,r4,r3
-          {  carry := boolean(dest-source < count) = boolean(overlap) }
-          subc    r10,r10,r5
-
-          {  count < 15 ? (to decide whether we will move dwords or bytes  }
-          cmpwi   cr1,r5,15
-
-          {  if overlap, then r10 := -1 else r10 := 0  }
-          subfe   r10,r10,r10
-
-          {  count < 39 ? (32 + max. alignment (7) }
-          cmpwi   cr7,r5,39
-
-          {  if count <= 0, stop  }
-          ble     cr0,LMoveDone
-
-          {  load the begin of the source in the data cache }
-          dcbt    0,r3
-          { and the dest as well }
-          dcbst   0,r4
-
-          {  if overlap, then r0 := count else r0 := 0  }
-          and     r0,r5,r10
-          {  if overlap, then point source and dest to the end  }
-          add     r3,r3,r0
-          add     r4,r4,r0
-          {  if overlap, then r0 := 0, else r0 := -1  }
-          not     r0,r10
-          {  if overlap, then r10 := -2, else r10 := 0  }
-          slwi    r10,r10,1
-          {  if overlap, then r10 := -1, else r10 := 1  }
-          addi    r10,r10,1
-          {  if overlap, then source/dest += -1, otherwise they stay }
-          {  After the next instruction, r3/r4 + r10 = next position }
-          {  to load/store from/to                                   }
-          add     r3,r3,r0
-          add     r4,r4,r0
-
-          {  if count < 15, copy everything byte by byte  }
-          blt     cr1,LMoveBytes
-
-          {  otherwise, guarantee 4 byte alignment for dest for starters  }
-LMove4ByteAlignLoop:
-          lbzux   r0,r3,r10
-          stbux   r0,r4,r10
-          {  is dest now 4 aligned?  }
-          andi.   r0,r4,3
-          subi    r5,r5,1
-          {  while not aligned, continue  }
-          bne     cr0,LMove4ByteAlignLoop
-
-          { check for 8 byte alignment }
-          andi.   r0,r4,7
-          { we are going to copy one byte again (the one at the newly }
-          { aligned address), so increase count byte 1                }
-          addi    r5,r5,1
-          { count div 4 for number of dwords to copy }
-          srwi    r0,r5,2
-          {  if 11 <= count < 39, copy using dwords }
-          blt     cr7,LMoveDWords
-
-          { multiply the update count with 4 }
-          slwi    r10,r10,2
-
-          beq     cr0,L8BytesAligned
-
-          {  count >= 39 -> align to 8 byte boundary and then use the FPU  }
-          {  since we're already at 4 byte alignment, use dword store      }
-          lwzux   r0,r3,r10
-          stwux   r0,r4,r10
-          subi    r5,r5,4
-L8BytesAligned:
-          { count div 32 ( >= 1, since count was >=39 }
-          srwi    r0,r5,5
-          { remainder }
-          andi.   r5,r5,31
-          { to decide if we will do some dword stores (instead of only }
-          { byte stores) afterwards or not                             }
-          cmpwi   cr1,r5,11
-          mtctr   r0
-
-          {  r0 := count div 4, will be moved to ctr when copying dwords  }
-          srwi    r0,r5,2
-
-          {  adjust the update count: it will now be 8 or -8 depending on overlap  }
-          slwi    r10,r10,1
-
-          {  adjust source and dest pointers: because of the above loop, dest is now   }
-          {  aligned to 8 bytes. So if we substract r10 we will still have an 8 bytes  }
-          { aligned address)                                                           }
-          sub     r3,r3,r10
-          sub     r4,r4,r10
-
-LMove32ByteLoop:
-          lfdux   f0,r3,r10
-          lfdux   f1,r3,r10
-          lfdux   f2,r3,r10
-          lfdux   f3,r3,r10
-          stfdux  f0,r4,r10
-          stfdux  f1,r4,r10
-          stfdux  f2,r4,r10
-          stfdux  f3,r4,r10
-          bdnz    LMove32ByteLoop
-
-          { cr0*4+eq is true if "count and 31" = 0 }
-          beq     cr0,LMoveDone
-
-          {  make r10 again -1 or 1, but first adjust source/dest pointers }
-          add     r3,r3,r10
-          add     r4,r4,r10
-          srawi   r10,r10,3
-          sub     r3,r3,r10
-          sub     r4,r4,r10
-
-          { cr1 contains whether count <= 11 }
-          ble     cr1,LMoveBytes
-          add     r3,r3,r10
-          add     r4,r4,r10
-
-LMoveDWords:
-          mtctr   r0
-          andi.   r5,r5,3
-          {  r10 * 4  }
-          slwi    r10,r10,2
-          sub     r3,r3,r10
-          sub     r4,r4,r10
-
-LMoveDWordsLoop:
-          lwzux   r0,r3,r10
-          stwux   r0,r4,r10
-          bdnz    LMoveDWordsLoop
-
-          beq     cr0,LMoveDone
-          {  make r10 again -1 or 1  }
-          add     r3,r3,r10
-          add     r4,r4,r10
-          srawi   r10,r10,2
-          sub     r3,r3,r10
-          sub     r4,r4,r10
-LMoveBytes:
-          mtctr   r5
-LMoveBytesLoop:
-          lbzux   r0,r3,r10
-          stbux   r0,r4,r10
-          bdnz    LMoveBytesLoop
-LMoveDone:
-end ['R0','R3','R4','R5','R10','F0','F11','F12','F13','CTR','CR0','CR1','CR7'];
-
-
-{$define FPC_SYSTEM_HAS_FILLCHAR}
-
-Procedure FillChar(var x;count:longint;value:byte);assembler;
-{ input: x in r3, count in r4, value in r5 }
-
-{$ifndef ABI_AIX}
-{ in the AIX ABI, we can use te red zone for temp storage, otherwise we have }
-{ to explicitely allocate room                                               }
-var
-  temp : packed record
-    case byte of
-      0: (l1,l2: longint);
-      1: (d: double);
-    end;
-{$endif ABI_AIX}
-asm
-        { no bytes? }
-        cmpwi     cr6,r4,0
-        { less than 15 bytes? }
-        cmpwi     cr7,r4,15
-        { less than 63 bytes? }
-        cmpwi     cr1,r4,63
-        { fill r5 with ValueValueValueValue }
-        rlwimi    r5,r5,8,16,23
-        { setup for aligning x to multiple of 4}
-        rlwinm    r10,r3,0,31-2+1,31
-        rlwimi    r5,r5,16,0,15
-        beq       cr6,LFillCharDone
-        { get the start of the data in the cache (and mark it as "will be }
-        { modified")                                                      }
-        dcbst     0,r3
-        subfic    r10,r10,4
-        blt       cr7,LFillCharVerySmall
-        { just store 4 bytes instead of using a loop to align (there are }
-        { plenty of other instructions now to keep the processor busy    }
-        { while it handles the (possibly unaligned) store)               }
-        stw       r5,0(r3)
-        { r3 := align(r3,4) }
-        add       r3,r3,r10
-        { decrease count with number of bytes already stored }
-        sub       r4,r4,r10
-        blt       cr1,LFillCharSmall
-        { if we have to fill with 0 (which happens a lot), we can simply use }
-        { dcbz for the most part, which is very fast, so make a special case }
-        { for that                                                           }
-        cmplwi    cr1,r5,0
-        { align to a multiple of 32 (and immediately check whether we aren't }
-        { already 32 byte aligned)                                           }
-        rlwinm.   r10,r3,0,31-5+1,31
-        { setup r3 for using update forms of store instructions }
-        subi      r3,r3,4
-        { get number of bytes to store }
-        subfic    r10,r10,32
-        { if already 32byte aligned, skip align loop }
-        beq       L32ByteAlignLoopDone
-        { substract from the total count }
-        sub       r4,r4,r10
-L32ByteAlignLoop:
-        { we were already aligned to 4 byres, so this will count down to }
-        { exactly 0                                                      }
-        subic.    r10,r10,4
-        stwu      r5,4(r3)
-        bne       L32ByteAlignLoop
-L32ByteAlignLoopDone:
-        { get the amount of 32 byte blocks }
-        srwi      r10,r4,5
-        { and keep the rest in r4 (recording whether there is any rest) }
-        rlwinm.   r4,r4,0,31-5+2,31
-        { move to ctr }
-        mtctr     r10
-        { check how many rest there is (to decide whether we'll use }
-        { FillCharSmall or FillCharVerySmall)                       }
-        cmpl      cr7,r4,11
-        { if filling with zero, only use dcbz }
-        bne       cr1, LFillCharNoZero
-        { make r3 point again to the actual store position }
-        addi      r3,r3,4
-LFillCharDCBZLoop:
-        dcbz      0,r3
-        addi      r3,r3,32
-        bdnz      LFillCharDCBZLoop
-        { if there was no rest, we're finished }
-        beq       LFillCharDone
-        b         LFillCharSmall
-LFillCharNoZero:
-{$ifdef ABI_AIX}
-        stw       r5,0(sp)
-        stw       r5,4(sp)
-        lfd       f0,0(sp)
-{$else ABI_AIX}
-        stw       r5,temp
-        stw       r5,4+temp
-        lfd       f0,temp
-{$endif ABI_AIX}
-        { make r3 point to address-8, so we're able to use fp double stores }
-        { with update (it's already -4 now)                                 }
-        subi      r3,r3,4
-        { load r10 with 8, so that dcbz uses the correct address }
-LFillChar32ByteLoop:
-        dcbz      r3,r10
-        stfdu     f0,8(r3)
-        stfdu     f0,8(r3)
-        stfdu     f0,8(r3)
-        stfdu     f0,8(r3)
-        bdnz      LFillChar32ByteLoop
-        { if there was no rest, we're finished }
-        beq       LFillCharDone
-LFillCharSmall:
-        { when we arrive here, we're already 4 byte aligned }
-        { get count div 4 to store dwords }
-        srwi      r10,r4,2
-        { get ready for use of update stores }
-        subi      r3,r3,4
-        mtctr     r10
-        rlwinm.   r4,r4,0,31-2+1,31
-LFillCharSmallLoop:
-        stwu      r5,4(r3)
-        bdnz      LFillCharSmallLoop
-        { if nothing left, stop }
-        beq       LFillCharDone
-        { get ready to store bytes }
-        addi      r3,r3,4
-LFillCharVerySmall:
-        mtctr     r4
-        subi      r3,r3,1
-LFillCharVerySmallLoop:
-        stbu      r5,1(r3)
-        bdnz      LFillCharVerySmallLoop
-LFillCharDone:
-end;
-
-
-{$define FPC_SYSTEM_HAS_FILLDWORD}
-procedure filldword(var x;count : longint;value : dword);
-assembler;
-asm
-{       registers:
-        r3              x
-        r4              count
-        r5              value
-        r13             value.value
-        r14             ptr to dest word
-        r15             increment 1
-        r16             increment 2
-        r17             scratch
-        r18             scratch
-        f1              value.value.value.value
-}
-                cmpwi   cr0,r3,0
-                mtctr   r4
-                subi    r3,r3,4
-                ble    .FillWordEnd    //if count<=0 Then Exit
-.FillWordLoop:
-                stwu    r5,4(r3)
-                bdnz    .FillWordLoop
-.FillWordEnd:
-end ['R3','R4','R5','CTR'];
-
-
-{$define FPC_SYSTEM_HAS_INDEXBYTE}
-function IndexByte(var buf;len:longint;b:byte):longint; assembler;
-{ input: r3 = buf, r4 = len, r5 = b                   }
-{ output: r3 = position of b in buf (-1 if not found) }
-asm
-                {  load the begin of the buffer in the data cache }
-                dcbt    0,r3
-                cmplwi  r4,0
-                mtctr   r4
-                subi    r10,r3,1
-                mr      r0,r3
-                { assume not found }
-                li      r3,-1
-                beq     LIndexByteDone
-LIndexByteLoop:
-                lbzu    r9,1(r10)
-                cmplw   r9,r5
-                bdnzf   cr0*4+eq,LIndexByteLoop
-                { r3 still contains -1 here }
-                bne     LIndexByteDone
-                sub     r3,r10,r0
-LIndexByteDone:
-end ['R0','R3','R9','R10','CR0','CTR'];
-
-
-{$define FPC_SYSTEM_HAS_INDEXWORD}
-function IndexWord(var buf;len:longint;b:word):longint; assembler;
-{ input: r3 = buf, r4 = len, r5 = b                   }
-{ output: r3 = position of b in buf (-1 if not found) }
-asm
-                {  load the begin of the buffer in the data cache }
-                dcbt    0,r3
-                cmplwi  r4,0
-                mtctr   r4
-                subi    r10,r3,2
-                mr      r0,r3
-                { assume not found }
-                li      r3,-1
-                beq     LIndexWordDone
-LIndexWordLoop:
-                lhzu    r9,2(r10)
-                cmplw   r9,r5
-                bdnzf   cr0*4+eq,LIndexWordLoop
-                { r3 still contains -1 here }
-                bne     LIndexWordDone
-                sub     r3,r10,r0
-LIndexWordDone:
-end ['R0','R3','R9','R10','CR0','CTR'];
-
-
-{$define FPC_SYSTEM_HAS_INDEXDWORD}
-function IndexDWord(var buf;len:longint;b:DWord):longint; assembler;
-{ input: r3 = buf, r4 = len, r5 = b                   }
-{ output: r3 = position of b in buf (-1 if not found) }
-asm
-                {  load the begin of the buffer in the data cache }
-                dcbt    0,r3
-                cmplwi  r4,0
-                mtctr   r4
-                subi    r10,r3,4
-                mr      r0,r3
-                { assume not found }
-                li      r3,-1
-                beq     LIndexDWordDone
-LIndexDWordLoop:
-                lwzu    r9,4(r30)
-                cmplw   r9,r5
-                bdnzf   cr0*4+eq, LIndexDWordLoop
-                { r3 still contains -1 here }
-                bne     LIndexDWordDone
-                sub     r3,r10,r0
-LIndexDWordDone:
-end ['R0','R3','R9','R10','CR0','CTR'];
-
-{$define FPC_SYSTEM_HAS_COMPAREBYTE}
-function CompareByte(var buf1,buf2;len:longint):longint; assembler;
-{ input: r3 = buf1, r4 = buf2, r5 = len                           }
-{ output: r3 = 0 if equal, < 0 if buf1 < str2, > 0 if buf1 > str2 }
-{ note: almost direct copy of strlcomp() from strings.inc         }
-asm
-        {  load the begin of the first buffer in the data cache }
-        dcbt    0,r3
-        { use r0 instead of r3 for buf1 since r3 contains result }
-        cmplwi  r5,0
-        mtctr   r5
-        subi    r11,r3,1
-        subi    r4,r4,1
-        li      r3,0
-        beq     LCompByteDone
-LCompByteLoop:
-        { load next chars }
-        lbzu    r9,1(r11)
-        lbzu    r10,1(r4)
-        { calculate difference }
-        sub.    r3,r9,r10
-        { if chars not equal or at the end, we're ready }
-        bdnzt   cr0*4+eq, LCompByteLoop
-LCompByteDone:
-end ['R0','R3','R4','R9','R10','R11','CR0','CTR'];
-
-{$define FPC_SYSTEM_HAS_COMPAREWORD}
-function CompareWord(var buf1,buf2;len:longint):longint; assembler;
-{ input: r3 = buf1, r4 = buf2, r5 = len                           }
-{ output: r3 = 0 if equal, < 0 if buf1 < str2, > 0 if buf1 > str2 }
-{ note: almost direct copy of strlcomp() from strings.inc         }
-asm
-        {  load the begin of the first buffer in the data cache }
-        dcbt    0,r3
-        { use r0 instead of r3 for buf1 since r3 contains result }
-        cmplwi  r5,0
-        mtctr   r5
-        subi    r11,r3,2
-        subi    r4,r4,2
-        li      r3,0
-        beq     LCompWordDone
-LCompWordLoop:
-        { load next chars }
-        lhzu    r9,2(r11)
-        lhzu    r10,2(r4)
-        { calculate difference }
-        sub.    r3,r9,r10
-        { if chars not equal or at the end, we're ready }
-        bdnzt   cr0*4+eq, LCompWordLoop
-LCompWordDone:
-end ['R0','R3','R4','R9','R10','R11','CR0','CTR'];
-
-
-{$define FPC_SYSTEM_HAS_COMPAREDWORD}
-function CompareDWord(var buf1,buf2;len:longint):longint; assembler;
-{ input: r3 = buf1, r4 = buf2, r5 = len                           }
-{ output: r3 = 0 if equal, < 0 if buf1 < str2, > 0 if buf1 > str2 }
-{ note: almost direct copy of strlcomp() from strings.inc         }
-asm
-        {  load the begin of the first buffer in the data cache }
-        dcbt    0,r3
-        { use r0 instead of r3 for buf1 since r3 contains result }
-        cmplwi  r5,0
-        mtctr   r5
-        subi    r11,r3,4
-        subi    r4,r4,4
-        li      r3,0
-        beq     LCompDWordDone
-LCompDWordLoop:
-        { load next chars }
-        lwzu    r9,4(r11)
-        lwzu    r10,4(r4)
-        { calculate difference }
-        sub.    r3,r9,r10
-        { if chars not equal or at the end, we're ready }
-        bdnzt   cr0*4+eq, LCompDWordLoop
-LCompDWordDone:
-end ['R0','R3','R4','R9','R10','R11','CR0','CTR'];
-
-{$define FPC_SYSTEM_HAS_INDEXCHAR0}
-function IndexChar0(var buf;len:longint;b:Char):longint; assembler;
-{ input: r3 = buf, r4 = len, r5 = b                         }
-{ output: r3 = position of found position (-1 if not found) }
-asm
-        {  load the begin of the buffer in the data cache }
-        dcbt    0,r3
-        { length = 0? }
-        cmplwi  r4,0
-        mtctr   r4
-        subi    r9,r3,1
-        mr      r0,r9
-        { assume not found }
-        li      r3,-1
-        { if yes, do nothing }
-        beq     LIndexChar0Done
-        subi    r3,r3,1
-LIndexChar0Loop:
-        lbzu    r10,1(r9)
-        cmplwi  cr1,r10,0
-        cmplw   r10,r5
-        beq     cr1,LIndexChar0Done
-        bdnzf   cr0*4+eq, LIndexChar0Loop
-        bne     LIndexChar0Done
-        sub     r3,r9,r0
-LIndexChar0Done:
-end ['R0','R3','R4','R9','R10','CR0','CTR'];
-
-
-{****************************************************************************
-                              Object Helpers
-****************************************************************************}
-
-{ use generic implementation for now }
-{ that's a problem currently, the generic has a another prototyp than this defined in compproc.inc (FK) }
-
-{$define FPC_SYSTEM_HAS_FPC_HELP_CONSTRUCTOR}
-procedure fpc_help_constructor; assembler;compilerproc;
-asm
-end;
-
-{$define FPC_SYSTEM_HAS_FPC_HELP_FAIL}
-procedure fpc_help_fail;assembler;[public,alias:'FPC_HELP_FAIL']; compilerproc;
-assembler;
-asm
-{$warning FIX ME!}
-// !!!!!!!!!!!
-end;
-
-
-{$define FPC_SYSTEM_HAS_FPC_HELP_DESTRUCTOR}
-{ use generic implementation for now }
-{ that's a problem currently, the generic has a another prototyp than this defined in compproc.inc (FK) }
-
-procedure fpc_help_destructor;assembler; compilerproc;
-asm
-end;
-
-{$define FPC_SYSTEM_HAS_FPC_NEW_CLASS}
-procedure fpc_new_class;assembler;[public,alias:'FPC_NEW_CLASS']; compilerproc;
-assembler;
-asm
-{$warning FIX ME!}
-// !!!!!!!!!!!
-end;
-
-
-{$define FPC_SYSTEM_HAS_FPC_DISPOSE_CLASS}
-procedure fpc_dispose_class;assembler;[public,alias:'FPC_DISPOSE_CLASS']; compilerproc;
-assembler;
-asm
-{$warning FIX ME!}
-// !!!!!!!!!!!
-end;
-
-{$define FPC_SYSTEM_HAS_FPC_HELP_FAIL_CLASS}
-procedure fpc_help_fail_class;assembler;[public,alias:'FPC_HELP_FAIL_CLASS']; {$ifdef hascompilerproc} compilerproc; {$endif}
-{ a non zero class must allways be disposed
-  VMT is allways at pos 0 }
-assembler;
-asm
-{$warning FIX ME!}
-// !!!!!!!!!!!
-end;
-
-
-
-{$define FPC_SYSTEM_HAS_FPC_CHECK_OBJECT}
-{ use generic implementation for now }
-{ that's a problem currently, the generic has a another prototy than this defined in compproc.inc (FK) }
-procedure fpc_check_object(obj : pointer);assembler; compilerproc;
-asm
-{$warning FIX ME!}
-// !!!!!!!!!!!
-end;
-
-{ use generic implementation for now }
-{ that's a problem currently, the generic has a another prototy than this defined in compproc.inc (FK) }
-{$define FPC_SYSTEM_HAS_FPC_CHECK_OBJECT_EXT}
-procedure fpc_check_object_ext; compilerproc;assembler;
-asm
-{$warning FIX ME!}
-// !!!!!!!!!!!
-end;
-
-{****************************************************************************
-                                 String
-****************************************************************************}
-
-{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_COPY}
-function fpc_shortstr_to_shortstr(len:longint; const sstr: shortstring): shortstring; [public,alias: 'FPC_SHORTSTR_TO_SHORTSTR']; compilerproc;
-assembler;
-{ input: r3: pointer to result, r4: len, r5: sstr }
-asm
-        { load length source }
-        lbz     r10,0(r5)
-        {  load the begin of the dest buffer in the data cache }
-        dcbtst  r0,r3
-
-        { put min(length(sstr),len) in r3 }
-        subc    r0,r4,r10     { r0 := r3 - r10                               }
-        subfme  r4,r4         { if r3 >= r4 then r3' := 0 else r3' := -1     }
-        and     r4,r0,r4      { if r3 >= r4 then r3' := 0 else r3' := r3-r10 }
-        add     r4,r4,r10     { if r3 >= r4 then r3' := r10 else r3' := r3   }
-
-        cmplwi  r4,0
-        { put length in ctr }
-        mtctr   r4
-        stb     r4,0(r3)
-        beq     LShortStrCopyDone
-LShortStrCopyLoop:
-        lbzu    r0,1(r5)
-        stbu    r0,1(r3)
-        bdnz    LShortStrCopyLoop
-end ['R0','R3','R4','R5','R10','CR0','CTR'];
-
-
-{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_COPY}
-procedure fpc_shortstr_copy(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_COPY'];
-assembler;
-{ input: r3: len, r4: sstr, r5: dstr }
-asm
-        { load length source }
-        lbz     r10,0(r4)
-        {  load the begin of the dest buffer in the data cache }
-        dcbtst  r0,r5
-
-        { put min(length(sstr),len) in r3 }
-        subc    r0,r3,r10    { r0 := r3 - r10                               }
-        subfme  r3,r3        { if r3 >= r4 then r3' := 0 else r3' := -1     }
-        and     r3,r0,r3     { if r3 >= r4 then r3' := 0 else r3' := r3-r10 }
-        add     r3,r3,r10    { if r3 >= r4 then r3' := r10 else r3' := r3   }
-
-        cmplwi  r3,0
-        { put length in ctr }
-        mtctr   r3
-        stb     r3,0(r5)
-        beq     LShortStrCopyDone2
-LShortStrCopyLoop2:
-        lbzu    r0,1(r4)
-        stbu    r0,1(r5)
-        bdnz    LShortStrCopyLoop2
-end ['R0','R3','R4','R5','R10','CR0','CTR'];
-
-{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
-function fpc_shortstr_concat(const s1,s2: shortstring): shortstring; compilerproc;
-{ expects that results (r3) contains a pointer to the current string and s1 }
-{ (r4) a pointer to the one that has to be concatenated                     }
-assembler;
-asm
-      { load length s1 }
-      lbz     r9, 0(r4)
-      { load length result }
-      lbz     r10, 0(r3)
-      { go to last current character of result }
-      add     r4,r9,r4
-
-      { calculate min(length(s1),255-length(result)) }
-      subfic  r9,r9,255
-      subc    r8,r9,r10    { r8 := r9 - r10                               }
-      subfme  r9,r9        { if r9 >= r10 then r9' := 0 else r9' := -1    }
-      and     r9,r8,r9     { if r9 >= r10 then r9' := 0 else r9' := r9-r8 }
-      add     r9,r9,r10    { if r9 >= r10 then r9' := r10 else r9' := r9  }
-
-      { and concatenate }
-      mtctr   r9
-LShortStrConcatLoop:
-      lbzu    r10,1(r4)
-      stbu    r10,1(r3)
-      bdnz    LShortStrConcatLoop
-end ['R3','R4','R8','R9','R10','CTR'];
-
-
-{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE}
-function fpc_shortstr_compare(const dstr,sstr:shortstring): longint; [public,alias:'FPC_SHORTSTR_COMPARE']; compilerproc;
-assembler;
-asm
-      { load length sstr }
-      lbz     r9,0(r4)
-      { load length dstr }
-      lbz     r10,0(r3)
-      { save their difference for later and      }
-      { calculate min(length(sstr),length(dstr)) }
-      subc    r0,r9,r10    { r0 := r9 - r10                               }
-      subfme  r9,r9        { if r9 >= r10 then r9' := 0 else r9' := -1    }
-      and     r9,r0,r9     { if r9 >= r10 then r9' := 0 else r9' := r9-r8 }
-      add     r9,r9,r10    { if r9 >= r10 then r9' := r10 else r9' := r9  }
-
-      { first compare dwords (length/4) }
-      srwi.   r8,r9,2
-      { keep length mod 4 for the ends }
-      rlwinm  r9,r9,0,30,31
-      { already check whether length mod 4 = 0 }
-      cmplwi  cr1,r9,0
-      { length div 4 in ctr for loop }
-      mtctr   r8
-      { if length < 3, goto byte comparing }
-      beq     LShortStrCompare1
-      { setup for use of update forms of load/store with dwords }
-      subi    r4,r4,3
-      subi    r8,r3,3
-LShortStrCompare4Loop:
-      lwzu    r3,4(r4)
-      lwzu    r10,4(r8)
-      sub.    r3,r3,r10
-      bdnzt   cr0+eq,LShortStrCompare4Loop
-      { r3 contains result if we stopped because of "ne" flag }
-      bne     LShortStrCompareDone
-      { setup for use of update forms of load/store with bytes }
-      addi    r4,r4,3
-      addi    r8,r8,3
-LShortStrCompare1:
-      { if comparelen mod 4 = 0, skip this and return the difference in }
-      { lengths                                                         }
-      beq     cr1,LShortStrCompareLen
-LShortStrCompare1Loop:
-      lbzu    r3,1(r4)
-      lbzu    r10,1(r8)
-      sub.    r3,r3,r10
-      bdnzt   cr0+eq,LShortStrCompare4Loop
-      bne     LShortStrCompareDone
-LShortStrCompareLen:
-      { also return result in flags, maybe we can use this in the CG }
-      mr.     r3,r0
-LShortStrCompareDone:
-end ['R0','R3','R4','R8','R9','R10','CR0','CR1','CTR'];
-
-
-{$define FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
-function fpc_pchar_to_shortstr(p:pchar):shortstring;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; compilerproc;
-assembler;
-{$include strpas.inc}
-
-
-{$define FPC_SYSTEM_HAS_STRLEN}
-function strlen(p:pchar):longint;assembler;
-{$include strlen.inc}
-
-
-{$define FPC_SYSTEM_HAS_GET_FRAME}
-function get_frame:longint;assembler;
-asm
-    {$warning FIX ME!}
-    //    !!!!!!! depends on ABI !!!!!!!!
-end ['R3'];
-
-
-{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
-function get_caller_addr(framebp:longint):longint;assembler;
-asm
-   {$warning FIX ME!}
-    //     !!!!!!! depends on ABI !!!!!!!!
-end ['R3'];
-
-
-{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
-function get_caller_frame(framebp:longint):longint;assembler;
-asm
-    {$warning FIX ME!}
-   //     !!!!!!! depends on ABI !!!!!!!!
-end ['R3'];
-
-{$define FPC_SYSTEM_HAS_ABS_LONGINT}
-function abs(l:longint):longint; assembler;[internconst:in_const_abs];
-asm
-        srawi   r0,r3,31
-        add     r3,r0,r3
-        xor     r3,r3,r0
-end ['R0','R3'];
-
-
-{****************************************************************************
-                                 Math
-****************************************************************************}
-
-{$define FPC_SYSTEM_HAS_ODD_LONGINT}
-function odd(l:longint):boolean;assembler;[internconst:in_const_odd];
-asm
-        rlwinm  r3,r3,0,31,31
-end ['R3'];
-
-
-{$define FPC_SYSTEM_HAS_SQR_LONGINT}
-function sqr(l:longint):longint;assembler;[internconst:in_const_sqr];
-asm
-        mullw   r3,r3,r3
-end ['R3'];
-
-
-{$define FPC_SYSTEM_HAS_SPTR}
-Function Sptr : Longint;assembler;
-asm
-        mr    r3,r1
-end ['R3'];
-
-
-{****************************************************************************
-                                 Str()
-****************************************************************************}
-
-{ int_str: generic implementation is used for now }
-
-
-{****************************************************************************
-                             Multithreading
-****************************************************************************}
-
-{ do a thread save inc/dec }
-
-function declocked(var l : longint) : boolean;assembler;
-{ input:  address of l in r3                                      }
-{ output: boolean indicating whether l is zero after decrementing }
-asm
-LDecLockedLoop:
-{$ifdef MT}
-    lwarx   r10,0,r3
-    subi    r10,r10,1
-    stwcx.  r10,0,r3
-    bne-    LDecLockedLoop
-{$else MT}
-    lwzx    r10,0,r3
-    subi    r10,r10,1
-    stw     r10,0(r3)
-{$endif MT}
-    mr.     r3,r10
-end ['R3','R10'];
-
-procedure inclocked(var l : longint);assembler;
-asm
-LIncLockedLoop:
-{$ifdef MT}
-    lwarx   r10,0,r3
-    addi    r10,r10,1
-    stwcx.  r10,0,r3
-    bne-    LDecLockedLoop
-{$else MT}
-    lwzx    r10,0,r3
-    addi    r10,r10,1
-    stw     r10,0(r3)
-{$endif MT}
-end ['R3','R10'];
-
-
-{
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2000-2001 by the Free Pascal development team.
+
+    Portions Copyright (c) 2000 by Casey Duncan ([email protected])
+
+    Processor dependent implementation for the system unit for
+    PowerPC
+
+    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.
+
+ **********************************************************************}
+
+
+{****************************************************************************
+                           PowerPC specific stuff
+****************************************************************************}
+
+{ This function is never called directly, it's a dummy to hold the register save/
+  load subroutines
+}
+procedure saverestorereg;assembler;
+asm
+{ exit }
+.global _restfpr_14_x
+_restfpr_14_x:  lfd     f14, -144(r11)
+.global _restfpr_15_x
+_restfpr_15_x:  lfd     f15, -136(r11)
+.global _restfpr_16_x
+_restfpr_16_x:  lfd     f16, -128(r11)
+.global _restfpr_17_x
+_restfpr_17_x:  lfd     f17, -120(r11)
+.global _restfpr_18_x
+_restfpr_18_x:  lfd     f18, -112(r11)
+.global _restfpr_19_x
+_restfpr_19_x:  lfd     f19, -104(r11)
+.global _restfpr_20_x
+_restfpr_20_x:  lfd     f20, -96(r11)
+.global _restfpr_21_x
+_restfpr_21_x:  lfd     f21, -88(r11)
+.global _restfpr_22_x
+_restfpr_22_x:  lfd     f22, -80(r11)
+.global _restfpr_23_x
+_restfpr_23_x:  lfd     f23, -72(r11)
+.global _restfpr_24_x
+_restfpr_24_x:  lfd     f24, -64(r11)
+.global _restfpr_25_x
+_restfpr_25_x:  lfd     f25, -56(r11)
+.global _restfpr_26_x
+_restfpr_26_x:  lfd     f26, -48(r11)
+.global _restfpr_27_x
+_restfpr_27_x:  lfd     f27, -40(r11)
+.global _restfpr_28_x
+_restfpr_28_x:  lfd     f28, -32(r11)
+.global _restfpr_29_x
+_restfpr_29_x:  lfd     f29, -24(r11)
+.global _restfpr_30_x
+_restfpr_30_x:  lfd     f30, -16(r11)
+.global _restfpr_31_x
+_restfpr_31_x:  lwz     r0, 4(r11)
+                lfd     f31, -8(r11)
+                mtlr    r0
+                ori     r1, r11, 0
+                blr
+
+{ exit with restoring lr }
+.global _restfpr_14_l
+_restfpr_14_l:  lfd     f14, -144(r11)
+.global _restfpr_15_l
+_restfpr_15_l:  lfd     f15, -136(r11)
+.global _restfpr_16_l
+_restfpr_16_l:  lfd     f16, -128(r11)
+.global _restfpr_17_l
+_restfpr_17_l:  lfd     f17, -120(r11)
+.global _restfpr_18_l
+_restfpr_18_l:  lfd     f18, -112(r11)
+.global _restfpr_19_l
+_restfpr_19_l:  lfd     f19, -104(r11)
+.global _restfpr_20_l
+_restfpr_20_l:  lfd     f20, -96(r11)
+.global _restfpr_21_l
+_restfpr_21_l:  lfd     f21, -88(r11)
+.global _restfpr_22_l
+_restfpr_22_l:  lfd     f22, -80(r11)
+.global _restfpr_23_l
+_restfpr_23_l:  lfd     f23, -72(r11)
+.global _restfpr_24_l
+_restfpr_24_l:  lfd     f24, -64(r11)
+.global _restfpr_25_l
+_restfpr_25_l:  lfd     f25, -56(r11)
+.global _restfpr_26_l
+_restfpr_26_l:  lfd     f26, -48(r11)
+.global _restfpr_27_l
+_restfpr_27_l:  lfd     f27, -40(r11)
+.global _restfpr_28_l
+_restfpr_28_l:  lfd     f28, -32(r11)
+.global _restfpr_29_l
+_restfpr_29_l:  lfd     f29, -24(r11)
+.global _restfpr_30_l
+_restfpr_30_l:  lfd     f30, -16(r11)
+.global _restfpr_31_l
+_restfpr_31_l:  lwz     r0, 4(r11)
+                lfd     f31, -8(r11)
+                mtlr    r0
+                ori     r1, r11, 0
+                blr
+end;
+
+
+{****************************************************************************
+                                Move / Fill
+****************************************************************************}
+
+{$define FPC_SYSTEM_HAS_MOVE}
+
+procedure Move(const source;var dest;count:longint);assembler;
+asm
+          {  count <= 0 ?  }
+          cmpwi   cr0,r5,0
+          {  check if we have to do the move backwards because of overlap  }
+          sub     r10,r4,r3
+          {  carry := boolean(dest-source < count) = boolean(overlap) }
+          subc    r10,r10,r5
+
+          {  count < 15 ? (to decide whether we will move dwords or bytes  }
+          cmpwi   cr1,r5,15
+
+          {  if overlap, then r10 := -1 else r10 := 0  }
+          subfe   r10,r10,r10
+
+          {  count < 39 ? (32 + max. alignment (7) }
+          cmpwi   cr7,r5,39
+
+          {  if count <= 0, stop  }
+          ble     cr0,LMoveDone
+
+          {  load the begin of the source in the data cache }
+          dcbt    0,r3
+          { and the dest as well }
+          dcbst   0,r4
+
+          {  if overlap, then r0 := count else r0 := 0  }
+          and     r0,r5,r10
+          {  if overlap, then point source and dest to the end  }
+          add     r3,r3,r0
+          add     r4,r4,r0
+          {  if overlap, then r0 := 0, else r0 := -1  }
+          not     r0,r10
+          {  if overlap, then r10 := -2, else r10 := 0  }
+          slwi    r10,r10,1
+          {  if overlap, then r10 := -1, else r10 := 1  }
+          addi    r10,r10,1
+          {  if overlap, then source/dest += -1, otherwise they stay }
+          {  After the next instruction, r3/r4 + r10 = next position }
+          {  to load/store from/to                                   }
+          add     r3,r3,r0
+          add     r4,r4,r0
+
+          {  if count < 15, copy everything byte by byte  }
+          blt     cr1,LMoveBytes
+
+          {  otherwise, guarantee 4 byte alignment for dest for starters  }
+LMove4ByteAlignLoop:
+          lbzux   r0,r3,r10
+          stbux   r0,r4,r10
+          {  is dest now 4 aligned?  }
+          andi.   r0,r4,3
+          subi    r5,r5,1
+          {  while not aligned, continue  }
+          bne     cr0,LMove4ByteAlignLoop
+
+          { check for 8 byte alignment }
+          andi.   r0,r4,7
+          { we are going to copy one byte again (the one at the newly }
+          { aligned address), so increase count byte 1                }
+          addi    r5,r5,1
+          { count div 4 for number of dwords to copy }
+          srwi    r0,r5,2
+          {  if 11 <= count < 39, copy using dwords }
+          blt     cr7,LMoveDWords
+
+          { multiply the update count with 4 }
+          slwi    r10,r10,2
+
+          beq     cr0,L8BytesAligned
+
+          {  count >= 39 -> align to 8 byte boundary and then use the FPU  }
+          {  since we're already at 4 byte alignment, use dword store      }
+          lwzux   r0,r3,r10
+          stwux   r0,r4,r10
+          subi    r5,r5,4
+L8BytesAligned:
+          { count div 32 ( >= 1, since count was >=39 }
+          srwi    r0,r5,5
+          { remainder }
+          andi.   r5,r5,31
+          { to decide if we will do some dword stores (instead of only }
+          { byte stores) afterwards or not                             }
+          cmpwi   cr1,r5,11
+          mtctr   r0
+
+          {  r0 := count div 4, will be moved to ctr when copying dwords  }
+          srwi    r0,r5,2
+
+          {  adjust the update count: it will now be 8 or -8 depending on overlap  }
+          slwi    r10,r10,1
+
+          {  adjust source and dest pointers: because of the above loop, dest is now   }
+          {  aligned to 8 bytes. So if we substract r10 we will still have an 8 bytes  }
+          { aligned address)                                                           }
+          sub     r3,r3,r10
+          sub     r4,r4,r10
+
+LMove32ByteLoop:
+          lfdux   f0,r3,r10
+          lfdux   f1,r3,r10
+          lfdux   f2,r3,r10
+          lfdux   f3,r3,r10
+          stfdux  f0,r4,r10
+          stfdux  f1,r4,r10
+          stfdux  f2,r4,r10
+          stfdux  f3,r4,r10
+          bdnz    LMove32ByteLoop
+
+          { cr0*4+eq is true if "count and 31" = 0 }
+          beq     cr0,LMoveDone
+
+          {  make r10 again -1 or 1, but first adjust source/dest pointers }
+          add     r3,r3,r10
+          add     r4,r4,r10
+          srawi   r10,r10,3
+          sub     r3,r3,r10
+          sub     r4,r4,r10
+
+          { cr1 contains whether count <= 11 }
+          ble     cr1,LMoveBytes
+          add     r3,r3,r10
+          add     r4,r4,r10
+
+LMoveDWords:
+          mtctr   r0
+          andi.   r5,r5,3
+          {  r10 * 4  }
+          slwi    r10,r10,2
+          sub     r3,r3,r10
+          sub     r4,r4,r10
+
+LMoveDWordsLoop:
+          lwzux   r0,r3,r10
+          stwux   r0,r4,r10
+          bdnz    LMoveDWordsLoop
+
+          beq     cr0,LMoveDone
+          {  make r10 again -1 or 1  }
+          add     r3,r3,r10
+          add     r4,r4,r10
+          srawi   r10,r10,2
+          sub     r3,r3,r10
+          sub     r4,r4,r10
+LMoveBytes:
+          mtctr   r5
+LMoveBytesLoop:
+          lbzux   r0,r3,r10
+          stbux   r0,r4,r10
+          bdnz    LMoveBytesLoop
+LMoveDone:
+end ['R0','R3','R4','R5','R10','F0','F11','F12','F13','CTR','CR0','CR1','CR7'];
+
+
+{$define FPC_SYSTEM_HAS_FILLCHAR}
+
+Procedure FillChar(var x;count:longint;value:byte);assembler;
+{ input: x in r3, count in r4, value in r5 }
+
+{$ifndef ABI_AIX}
+{ in the AIX ABI, we can use te red zone for temp storage, otherwise we have }
+{ to explicitely allocate room                                               }
+var
+  temp : packed record
+    case byte of
+      0: (l1,l2: longint);
+      1: (d: double);
+    end;
+{$endif ABI_AIX}
+asm
+        { no bytes? }
+        cmpwi     cr6,r4,0
+        { less than 15 bytes? }
+        cmpwi     cr7,r4,15
+        { less than 63 bytes? }
+        cmpwi     cr1,r4,63
+        { fill r5 with ValueValueValueValue }
+        rlwimi    r5,r5,8,16,23
+        { setup for aligning x to multiple of 4}
+        rlwinm    r10,r3,0,31-2+1,31
+        rlwimi    r5,r5,16,0,15
+        beq       cr6,LFillCharDone
+        { get the start of the data in the cache (and mark it as "will be }
+        { modified")                                                      }
+        dcbst     0,r3
+        subfic    r10,r10,4
+        blt       cr7,LFillCharVerySmall
+        { just store 4 bytes instead of using a loop to align (there are }
+        { plenty of other instructions now to keep the processor busy    }
+        { while it handles the (possibly unaligned) store)               }
+        stw       r5,0(r3)
+        { r3 := align(r3,4) }
+        add       r3,r3,r10
+        { decrease count with number of bytes already stored }
+        sub       r4,r4,r10
+        blt       cr1,LFillCharSmall
+        { if we have to fill with 0 (which happens a lot), we can simply use }
+        { dcbz for the most part, which is very fast, so make a special case }
+        { for that                                                           }
+        cmplwi    cr1,r5,0
+        { align to a multiple of 32 (and immediately check whether we aren't }
+        { already 32 byte aligned)                                           }
+        rlwinm.   r10,r3,0,31-5+1,31
+        { setup r3 for using update forms of store instructions }
+        subi      r3,r3,4
+        { get number of bytes to store }
+        subfic    r10,r10,32
+        { if already 32byte aligned, skip align loop }
+        beq       L32ByteAlignLoopDone
+        { substract from the total count }
+        sub       r4,r4,r10
+L32ByteAlignLoop:
+        { we were already aligned to 4 byres, so this will count down to }
+        { exactly 0                                                      }
+        subic.    r10,r10,4
+        stwu      r5,4(r3)
+        bne       L32ByteAlignLoop
+L32ByteAlignLoopDone:
+        { get the amount of 32 byte blocks }
+        srwi      r10,r4,5
+        { and keep the rest in r4 (recording whether there is any rest) }
+        rlwinm.   r4,r4,0,31-5+2,31
+        { move to ctr }
+        mtctr     r10
+        { check how many rest there is (to decide whether we'll use }
+        { FillCharSmall or FillCharVerySmall)                       }
+        cmpl      cr7,r4,11
+        { if filling with zero, only use dcbz }
+        bne       cr1, LFillCharNoZero
+        { make r3 point again to the actual store position }
+        addi      r3,r3,4
+LFillCharDCBZLoop:
+        dcbz      0,r3
+        addi      r3,r3,32
+        bdnz      LFillCharDCBZLoop
+        { if there was no rest, we're finished }
+        beq       LFillCharDone
+        b         LFillCharSmall
+LFillCharNoZero:
+{$ifdef ABI_AIX}
+        stw       r5,0(sp)
+        stw       r5,4(sp)
+        lfd       f0,0(sp)
+{$else ABI_AIX}
+        stw       r5,temp
+        stw       r5,4+temp
+        lfd       f0,temp
+{$endif ABI_AIX}
+        { make r3 point to address-8, so we're able to use fp double stores }
+        { with update (it's already -4 now)                                 }
+        subi      r3,r3,4
+        { load r10 with 8, so that dcbz uses the correct address }
+LFillChar32ByteLoop:
+        dcbz      r3,r10
+        stfdu     f0,8(r3)
+        stfdu     f0,8(r3)
+        stfdu     f0,8(r3)
+        stfdu     f0,8(r3)
+        bdnz      LFillChar32ByteLoop
+        { if there was no rest, we're finished }
+        beq       LFillCharDone
+LFillCharSmall:
+        { when we arrive here, we're already 4 byte aligned }
+        { get count div 4 to store dwords }
+        srwi      r10,r4,2
+        { get ready for use of update stores }
+        subi      r3,r3,4
+        mtctr     r10
+        rlwinm.   r4,r4,0,31-2+1,31
+LFillCharSmallLoop:
+        stwu      r5,4(r3)
+        bdnz      LFillCharSmallLoop
+        { if nothing left, stop }
+        beq       LFillCharDone
+        { get ready to store bytes }
+        addi      r3,r3,4
+LFillCharVerySmall:
+        mtctr     r4
+        subi      r3,r3,1
+LFillCharVerySmallLoop:
+        stbu      r5,1(r3)
+        bdnz      LFillCharVerySmallLoop
+LFillCharDone:
+end;
+
+
+{$define FPC_SYSTEM_HAS_FILLDWORD}
+procedure filldword(var x;count : longint;value : dword);
+assembler;
+asm
+{       registers:
+        r3              x
+        r4              count
+        r5              value
+        r13             value.value
+        r14             ptr to dest word
+        r15             increment 1
+        r16             increment 2
+        r17             scratch
+        r18             scratch
+        f1              value.value.value.value
+}
+                cmpwi   cr0,r3,0
+                mtctr   r4
+                subi    r3,r3,4
+                ble    .FillWordEnd    //if count<=0 Then Exit
+.FillWordLoop:
+                stwu    r5,4(r3)
+                bdnz    .FillWordLoop
+.FillWordEnd:
+end ['R3','R4','R5','CTR'];
+
+
+{$define FPC_SYSTEM_HAS_INDEXBYTE}
+function IndexByte(const buf;len:longint;b:byte):longint; assembler;
+{ input: r3 = buf, r4 = len, r5 = b                   }
+{ output: r3 = position of b in buf (-1 if not found) }
+asm
+                {  load the begin of the buffer in the data cache }
+                dcbt    0,r3
+                cmplwi  r4,0
+                mtctr   r4
+                subi    r10,r3,1
+                mr      r0,r3
+                { assume not found }
+                li      r3,-1
+                beq     LIndexByteDone
+LIndexByteLoop:
+                lbzu    r9,1(r10)
+                cmplw   r9,r5
+                bdnzf   cr0*4+eq,LIndexByteLoop
+                { r3 still contains -1 here }
+                bne     LIndexByteDone
+                sub     r3,r10,r0
+LIndexByteDone:
+end ['R0','R3','R9','R10','CR0','CTR'];
+
+
+{$define FPC_SYSTEM_HAS_INDEXWORD}
+function IndexWord(const buf;len:longint;b:word):longint; assembler;
+{ input: r3 = buf, r4 = len, r5 = b                   }
+{ output: r3 = position of b in buf (-1 if not found) }
+asm
+                {  load the begin of the buffer in the data cache }
+                dcbt    0,r3
+                cmplwi  r4,0
+                mtctr   r4
+                subi    r10,r3,2
+                mr      r0,r3
+                { assume not found }
+                li      r3,-1
+                beq     LIndexWordDone
+LIndexWordLoop:
+                lhzu    r9,2(r10)
+                cmplw   r9,r5
+                bdnzf   cr0*4+eq,LIndexWordLoop
+                { r3 still contains -1 here }
+                bne     LIndexWordDone
+                sub     r3,r10,r0
+LIndexWordDone:
+end ['R0','R3','R9','R10','CR0','CTR'];
+
+
+{$define FPC_SYSTEM_HAS_INDEXDWORD}
+function IndexDWord(const buf;len:longint;b:DWord):longint; assembler;
+{ input: r3 = buf, r4 = len, r5 = b                   }
+{ output: r3 = position of b in buf (-1 if not found) }
+asm
+                {  load the begin of the buffer in the data cache }
+                dcbt    0,r3
+                cmplwi  r4,0
+                mtctr   r4
+                subi    r10,r3,4
+                mr      r0,r3
+                { assume not found }
+                li      r3,-1
+                beq     LIndexDWordDone
+LIndexDWordLoop:
+                lwzu    r9,4(r30)
+                cmplw   r9,r5
+                bdnzf   cr0*4+eq, LIndexDWordLoop
+                { r3 still contains -1 here }
+                bne     LIndexDWordDone
+                sub     r3,r10,r0
+LIndexDWordDone:
+end ['R0','R3','R9','R10','CR0','CTR'];
+
+{$define FPC_SYSTEM_HAS_COMPAREBYTE}
+function CompareByte(const buf1,buf2;len:longint):longint; assembler;
+{ input: r3 = buf1, r4 = buf2, r5 = len                           }
+{ output: r3 = 0 if equal, < 0 if buf1 < str2, > 0 if buf1 > str2 }
+{ note: almost direct copy of strlcomp() from strings.inc         }
+asm
+        {  load the begin of the first buffer in the data cache }
+        dcbt    0,r3
+        { use r0 instead of r3 for buf1 since r3 contains result }
+        cmplwi  r5,0
+        mtctr   r5
+        subi    r11,r3,1
+        subi    r4,r4,1
+        li      r3,0
+        beq     LCompByteDone
+LCompByteLoop:
+        { load next chars }
+        lbzu    r9,1(r11)
+        lbzu    r10,1(r4)
+        { calculate difference }
+        sub.    r3,r9,r10
+        { if chars not equal or at the end, we're ready }
+        bdnzt   cr0*4+eq, LCompByteLoop
+LCompByteDone:
+end ['R0','R3','R4','R9','R10','R11','CR0','CTR'];
+
+{$define FPC_SYSTEM_HAS_COMPAREWORD}
+function CompareWord(const buf1,buf2;len:longint):longint; assembler;
+{ input: r3 = buf1, r4 = buf2, r5 = len                           }
+{ output: r3 = 0 if equal, < 0 if buf1 < str2, > 0 if buf1 > str2 }
+{ note: almost direct copy of strlcomp() from strings.inc         }
+asm
+        {  load the begin of the first buffer in the data cache }
+        dcbt    0,r3
+        { use r0 instead of r3 for buf1 since r3 contains result }
+        cmplwi  r5,0
+        mtctr   r5
+        subi    r11,r3,2
+        subi    r4,r4,2
+        li      r3,0
+        beq     LCompWordDone
+LCompWordLoop:
+        { load next chars }
+        lhzu    r9,2(r11)
+        lhzu    r10,2(r4)
+        { calculate difference }
+        sub.    r3,r9,r10
+        { if chars not equal or at the end, we're ready }
+        bdnzt   cr0*4+eq, LCompWordLoop
+LCompWordDone:
+end ['R0','R3','R4','R9','R10','R11','CR0','CTR'];
+
+
+{$define FPC_SYSTEM_HAS_COMPAREDWORD}
+function CompareDWord(const buf1,buf2;len:longint):longint; assembler;
+{ input: r3 = buf1, r4 = buf2, r5 = len                           }
+{ output: r3 = 0 if equal, < 0 if buf1 < str2, > 0 if buf1 > str2 }
+{ note: almost direct copy of strlcomp() from strings.inc         }
+asm
+        {  load the begin of the first buffer in the data cache }
+        dcbt    0,r3
+        { use r0 instead of r3 for buf1 since r3 contains result }
+        cmplwi  r5,0
+        mtctr   r5
+        subi    r11,r3,4
+        subi    r4,r4,4
+        li      r3,0
+        beq     LCompDWordDone
+LCompDWordLoop:
+        { load next chars }
+        lwzu    r9,4(r11)
+        lwzu    r10,4(r4)
+        { calculate difference }
+        sub.    r3,r9,r10
+        { if chars not equal or at the end, we're ready }
+        bdnzt   cr0*4+eq, LCompDWordLoop
+LCompDWordDone:
+end ['R0','R3','R4','R9','R10','R11','CR0','CTR'];
+
+{$define FPC_SYSTEM_HAS_INDEXCHAR0}
+function IndexChar0(const buf;len:longint;b:Char):longint; assembler;
+{ input: r3 = buf, r4 = len, r5 = b                         }
+{ output: r3 = position of found position (-1 if not found) }
+asm
+        {  load the begin of the buffer in the data cache }
+        dcbt    0,r3
+        { length = 0? }
+        cmplwi  r4,0
+        mtctr   r4
+        subi    r9,r3,1
+        mr      r0,r9
+        { assume not found }
+        li      r3,-1
+        { if yes, do nothing }
+        beq     LIndexChar0Done
+        subi    r3,r3,1
+LIndexChar0Loop:
+        lbzu    r10,1(r9)
+        cmplwi  cr1,r10,0
+        cmplw   r10,r5
+        beq     cr1,LIndexChar0Done
+        bdnzf   cr0*4+eq, LIndexChar0Loop
+        bne     LIndexChar0Done
+        sub     r3,r9,r0
+LIndexChar0Done:
+end ['R0','R3','R4','R9','R10','CR0','CTR'];
+
+
+{****************************************************************************
+                              Object Helpers
+****************************************************************************}
+
+{ use generic implementation for now }
+{ that's a problem currently, the generic has a another prototyp than this defined in compproc.inc (FK) }
+
+{$define FPC_SYSTEM_HAS_FPC_HELP_CONSTRUCTOR}
+procedure fpc_help_constructor; assembler;compilerproc;
+asm
+end;
+
+{$define FPC_SYSTEM_HAS_FPC_HELP_FAIL}
+procedure fpc_help_fail;assembler;[public,alias:'FPC_HELP_FAIL']; compilerproc;
+assembler;
+asm
+{$warning FIX ME!}
+// !!!!!!!!!!!
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_HELP_DESTRUCTOR}
+{ use generic implementation for now }
+{ that's a problem currently, the generic has a another prototyp than this defined in compproc.inc (FK) }
+
+procedure fpc_help_destructor;assembler; compilerproc;
+asm
+end;
+
+{$define FPC_SYSTEM_HAS_FPC_NEW_CLASS}
+procedure fpc_new_class;assembler;[public,alias:'FPC_NEW_CLASS']; compilerproc;
+assembler;
+asm
+{$warning FIX ME!}
+// !!!!!!!!!!!
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_DISPOSE_CLASS}
+procedure fpc_dispose_class;assembler;[public,alias:'FPC_DISPOSE_CLASS']; compilerproc;
+assembler;
+asm
+{$warning FIX ME!}
+// !!!!!!!!!!!
+end;
+
+{$define FPC_SYSTEM_HAS_FPC_HELP_FAIL_CLASS}
+procedure fpc_help_fail_class;assembler;[public,alias:'FPC_HELP_FAIL_CLASS']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{ a non zero class must allways be disposed
+  VMT is allways at pos 0 }
+assembler;
+asm
+{$warning FIX ME!}
+// !!!!!!!!!!!
+end;
+
+
+
+{$define FPC_SYSTEM_HAS_FPC_CHECK_OBJECT}
+{ use generic implementation for now }
+{ that's a problem currently, the generic has a another prototy than this defined in compproc.inc (FK) }
+procedure fpc_check_object(obj : pointer);assembler; compilerproc;
+asm
+{$warning FIX ME!}
+// !!!!!!!!!!!
+end;
+
+{ use generic implementation for now }
+{ that's a problem currently, the generic has a another prototy than this defined in compproc.inc (FK) }
+{$define FPC_SYSTEM_HAS_FPC_CHECK_OBJECT_EXT}
+procedure fpc_check_object_ext; compilerproc;assembler;
+asm
+{$warning FIX ME!}
+// !!!!!!!!!!!
+end;
+
+{****************************************************************************
+                                 String
+****************************************************************************}
+
+{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_COPY}
+function fpc_shortstr_to_shortstr(len:longint; const sstr: shortstring): shortstring; [public,alias: 'FPC_SHORTSTR_TO_SHORTSTR']; compilerproc;
+assembler;
+{ input: r3: pointer to result, r4: len, r5: sstr }
+asm
+        { load length source }
+        lbz     r10,0(r5)
+        {  load the begin of the dest buffer in the data cache }
+        dcbtst  r0,r3
+
+        { put min(length(sstr),len) in r3 }
+        subc    r0,r4,r10     { r0 := r3 - r10                               }
+        subfme  r4,r4         { if r3 >= r4 then r3' := 0 else r3' := -1     }
+        and     r4,r0,r4      { if r3 >= r4 then r3' := 0 else r3' := r3-r10 }
+        add     r4,r4,r10     { if r3 >= r4 then r3' := r10 else r3' := r3   }
+
+        cmplwi  r4,0
+        { put length in ctr }
+        mtctr   r4
+        stb     r4,0(r3)
+        beq     LShortStrCopyDone
+LShortStrCopyLoop:
+        lbzu    r0,1(r5)
+        stbu    r0,1(r3)
+        bdnz    LShortStrCopyLoop
+end ['R0','R3','R4','R5','R10','CR0','CTR'];
+
+
+{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_COPY}
+procedure fpc_shortstr_copy(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_COPY'];
+assembler;
+{ input: r3: len, r4: sstr, r5: dstr }
+asm
+        { load length source }
+        lbz     r10,0(r4)
+        {  load the begin of the dest buffer in the data cache }
+        dcbtst  r0,r5
+
+        { put min(length(sstr),len) in r3 }
+        subc    r0,r3,r10    { r0 := r3 - r10                               }
+        subfme  r3,r3        { if r3 >= r4 then r3' := 0 else r3' := -1     }
+        and     r3,r0,r3     { if r3 >= r4 then r3' := 0 else r3' := r3-r10 }
+        add     r3,r3,r10    { if r3 >= r4 then r3' := r10 else r3' := r3   }
+
+        cmplwi  r3,0
+        { put length in ctr }
+        mtctr   r3
+        stb     r3,0(r5)
+        beq     LShortStrCopyDone2
+LShortStrCopyLoop2:
+        lbzu    r0,1(r4)
+        stbu    r0,1(r5)
+        bdnz    LShortStrCopyLoop2
+end ['R0','R3','R4','R5','R10','CR0','CTR'];
+
+{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
+function fpc_shortstr_concat(const s1,s2: shortstring): shortstring; compilerproc;
+{ expects that results (r3) contains a pointer to the current string and s1 }
+{ (r4) a pointer to the one that has to be concatenated                     }
+assembler;
+asm
+      { load length s1 }
+      lbz     r9, 0(r4)
+      { load length result }
+      lbz     r10, 0(r3)
+      { go to last current character of result }
+      add     r4,r9,r4
+
+      { calculate min(length(s1),255-length(result)) }
+      subfic  r9,r9,255
+      subc    r8,r9,r10    { r8 := r9 - r10                               }
+      subfme  r9,r9        { if r9 >= r10 then r9' := 0 else r9' := -1    }
+      and     r9,r8,r9     { if r9 >= r10 then r9' := 0 else r9' := r9-r8 }
+      add     r9,r9,r10    { if r9 >= r10 then r9' := r10 else r9' := r9  }
+
+      { and concatenate }
+      mtctr   r9
+LShortStrConcatLoop:
+      lbzu    r10,1(r4)
+      stbu    r10,1(r3)
+      bdnz    LShortStrConcatLoop
+end ['R3','R4','R8','R9','R10','CTR'];
+
+
+{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE}
+function fpc_shortstr_compare(const dstr,sstr:shortstring): longint; [public,alias:'FPC_SHORTSTR_COMPARE']; compilerproc;
+assembler;
+asm
+      { load length sstr }
+      lbz     r9,0(r4)
+      { load length dstr }
+      lbz     r10,0(r3)
+      { save their difference for later and      }
+      { calculate min(length(sstr),length(dstr)) }
+      subc    r0,r9,r10    { r0 := r9 - r10                               }
+      subfme  r9,r9        { if r9 >= r10 then r9' := 0 else r9' := -1    }
+      and     r9,r0,r9     { if r9 >= r10 then r9' := 0 else r9' := r9-r8 }
+      add     r9,r9,r10    { if r9 >= r10 then r9' := r10 else r9' := r9  }
+
+      { first compare dwords (length/4) }
+      srwi.   r8,r9,2
+      { keep length mod 4 for the ends }
+      rlwinm  r9,r9,0,30,31
+      { already check whether length mod 4 = 0 }
+      cmplwi  cr1,r9,0
+      { length div 4 in ctr for loop }
+      mtctr   r8
+      { if length < 3, goto byte comparing }
+      beq     LShortStrCompare1
+      { setup for use of update forms of load/store with dwords }
+      subi    r4,r4,3
+      subi    r8,r3,3
+LShortStrCompare4Loop:
+      lwzu    r3,4(r4)
+      lwzu    r10,4(r8)
+      sub.    r3,r3,r10
+      bdnzt   cr0+eq,LShortStrCompare4Loop
+      { r3 contains result if we stopped because of "ne" flag }
+      bne     LShortStrCompareDone
+      { setup for use of update forms of load/store with bytes }
+      addi    r4,r4,3
+      addi    r8,r8,3
+LShortStrCompare1:
+      { if comparelen mod 4 = 0, skip this and return the difference in }
+      { lengths                                                         }
+      beq     cr1,LShortStrCompareLen
+LShortStrCompare1Loop:
+      lbzu    r3,1(r4)
+      lbzu    r10,1(r8)
+      sub.    r3,r3,r10
+      bdnzt   cr0+eq,LShortStrCompare4Loop
+      bne     LShortStrCompareDone
+LShortStrCompareLen:
+      { also return result in flags, maybe we can use this in the CG }
+      mr.     r3,r0
+LShortStrCompareDone:
+end ['R0','R3','R4','R8','R9','R10','CR0','CR1','CTR'];
+
+
+{$define FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
+function fpc_pchar_to_shortstr(p:pchar):shortstring;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; compilerproc;
+assembler;
+{$include strpas.inc}
+
+
+{$define FPC_SYSTEM_HAS_STRLEN}
+function strlen(p:pchar):longint;assembler;
+{$include strlen.inc}
+
+
+{$define FPC_SYSTEM_HAS_GET_FRAME}
+function get_frame:longint;assembler;
+asm
+    {$warning FIX ME!}
+    //    !!!!!!! depends on ABI !!!!!!!!
+end ['R3'];
+
+
+{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
+function get_caller_addr(framebp:longint):longint;assembler;
+asm
+   {$warning FIX ME!}
+    //     !!!!!!! depends on ABI !!!!!!!!
+end ['R3'];
+
+
+{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
+function get_caller_frame(framebp:longint):longint;assembler;
+asm
+    {$warning FIX ME!}
+   //     !!!!!!! depends on ABI !!!!!!!!
+end ['R3'];
+
+{$define FPC_SYSTEM_HAS_ABS_LONGINT}
+function abs(l:longint):longint; assembler;[internconst:in_const_abs];
+asm
+        srawi   r0,r3,31
+        add     r3,r0,r3
+        xor     r3,r3,r0
+end ['R0','R3'];
+
+
+{****************************************************************************
+                                 Math
+****************************************************************************}
+
+{$define FPC_SYSTEM_HAS_ODD_LONGINT}
+function odd(l:longint):boolean;assembler;[internconst:in_const_odd];
+asm
+        rlwinm  r3,r3,0,31,31
+end ['R3'];
+
+
+{$define FPC_SYSTEM_HAS_SQR_LONGINT}
+function sqr(l:longint):longint;assembler;[internconst:in_const_sqr];
+asm
+        mullw   r3,r3,r3
+end ['R3'];
+
+
+{$define FPC_SYSTEM_HAS_SPTR}
+Function Sptr : Longint;assembler;
+asm
+        mr    r3,r1
+end ['R3'];
+
+
+{****************************************************************************
+                                 Str()
+****************************************************************************}
+
+{ int_str: generic implementation is used for now }
+
+
+{****************************************************************************
+                             Multithreading
+****************************************************************************}
+
+{ do a thread save inc/dec }
+
+function declocked(var l : longint) : boolean;assembler;
+{ input:  address of l in r3                                      }
+{ output: boolean indicating whether l is zero after decrementing }
+asm
+LDecLockedLoop:
+{$ifdef MT}
+    lwarx   r10,0,r3
+    subi    r10,r10,1
+    stwcx.  r10,0,r3
+    bne-    LDecLockedLoop
+{$else MT}
+    lwzx    r10,0,r3
+    subi    r10,r10,1
+    stw     r10,0(r3)
+{$endif MT}
+    mr.     r3,r10
+end ['R3','R10'];
+
+procedure inclocked(var l : longint);assembler;
+asm
+LIncLockedLoop:
+{$ifdef MT}
+    lwarx   r10,0,r3
+    addi    r10,r10,1
+    stwcx.  r10,0,r3
+    bne-    LDecLockedLoop
+{$else MT}
+    lwzx    r10,0,r3
+    addi    r10,r10,1
+    stw     r10,0(r3)
+{$endif MT}
+end ['R3','R10'];
+
+
+{
   $Log$
-  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/30 17:29:53  florian
-    + dummy setjmp and longjmp added
-    + dummy implemtation of the destructor helper
-
-  Revision 1.10  2002/07/28 21:39:29  florian
-    * made abs a compiler proc if it is generic
-
-  Revision 1.9  2002/07/28 20:43:49  florian
-    * several fixes for linux/powerpc
-    * several fixes to MT
-
-  Revision 1.8  2002/07/26 15:45:56  florian
-    * changed multi threading define: it's MT instead of MTRTL
-
-  Revision 1.7  2001/09/28 13:28:49  jonas
-    * small changes to move (different count values trigger the selection of
-      moving bytes instead dwords/doubles and move dcbt instruction)
-    + implemented fillchar (untested)
-
-  Revision 1.6  2001/09/27 15:30:29  jonas
-    * conversion to compilerproc and to structure used by i386 rtl
-    * some bugfixes
-    * powerpc.inc is almost complete (only fillchar/word/dword, get_frame etc
-      and the class helpers are still needed
-    - removed unnecessary register saving in set.inc (thanks to compilerproc)
-    * use registers reserved for parameters as much as possible instead of
-      those reserved for local vars (since those have to be saved by the
-      called anyway, while the ones for local vars have to be saved by the
-      callee)
-
-  Revision 1.5  2001/07/07 12:46:12  jonas
-    * some small bugfixes and cache optimizations
-
-  Revision 1.4  2001/03/03 13:53:36  jonas
-    * fixed small bug in move
-
-  Revision 1.3  2001/03/02 13:24:10  jonas
-    + new, complete implementation of move procedure (including support for
-      overlapping regions)
-
-  Revision 1.2  2001/02/11 17:59:46  jonas
-    * implemented several more procedures
-
-  Revision 1.1  2000/07/27 07:32:12  jonas
-    + initial version by Casey Duncan (not yet thoroughly debugged or complete)
-}
+  Revision 1.15  2002-08-31 13:11:11  florian
+    * several fixes for Linux/PPC compilation
+
+  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/30 17:29:53  florian
+    + dummy setjmp and longjmp added
+    + dummy implemtation of the destructor helper
+
+  Revision 1.10  2002/07/28 21:39:29  florian
+    * made abs a compiler proc if it is generic
+
+  Revision 1.9  2002/07/28 20:43:49  florian
+    * several fixes for linux/powerpc
+    * several fixes to MT
+
+  Revision 1.8  2002/07/26 15:45:56  florian
+    * changed multi threading define: it's MT instead of MTRTL
+
+  Revision 1.7  2001/09/28 13:28:49  jonas
+    * small changes to move (different count values trigger the selection of
+      moving bytes instead dwords/doubles and move dcbt instruction)
+    + implemented fillchar (untested)
+
+  Revision 1.6  2001/09/27 15:30:29  jonas
+    * conversion to compilerproc and to structure used by i386 rtl
+    * some bugfixes
+    * powerpc.inc is almost complete (only fillchar/word/dword, get_frame etc
+      and the class helpers are still needed
+    - removed unnecessary register saving in set.inc (thanks to compilerproc)
+    * use registers reserved for parameters as much as possible instead of
+      those reserved for local vars (since those have to be saved by the
+      called anyway, while the ones for local vars have to be saved by the
+      callee)
+
+  Revision 1.5  2001/07/07 12:46:12  jonas
+    * some small bugfixes and cache optimizations
+
+  Revision 1.4  2001/03/03 13:53:36  jonas
+    * fixed small bug in move
+
+  Revision 1.3  2001/03/02 13:24:10  jonas
+    + new, complete implementation of move procedure (including support for
+      overlapping regions)
+
+  Revision 1.2  2001/02/11 17:59:46  jonas
+    * implemented several more procedures
+
+  Revision 1.1  2000/07/27 07:32:12  jonas
+    + initial version by Casey Duncan (not yet thoroughly debugged or complete)
+}