* fixed last commit (1337) which broke some files in the repository

git-svn-id: trunk@1338 -

.gitattributes

@@ -4084,6 +4084,7 @@ rtl/powerpc/makefile.cpu -text
 rtl/powerpc/math.inc svneol=native#text/plain
 rtl/powerpc/mathu.inc svneol=native#text/plain
 rtl/powerpc/mathuh.inc svneol=native#text/plain
+rtl/powerpc/powerpc.inc -text
 rtl/powerpc/set.inc svneol=native#text/plain
 rtl/powerpc/setjump.inc svneol=native#text/plain
 rtl/powerpc/setjumph.inc svneol=native#text/plain

compiler/dbgstabs.pas

@@ -0,0 +1,1535 @@
+{
+    Copyright (c) 2003-2004 by Peter Vreman and Florian Klaempfl
+
+    This units contains support for STABS debug info generation
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    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.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit dbgstabs;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      cclasses,
+      dbgbase,
+      symtype,symdef,symsym,symtable,symbase,
+      aasmtai;
+
+    type
+      TDebugInfoStabs=class(TDebugInfo)
+      private
+        writing_def_stabs  : boolean;
+        global_stab_number : word;
+        { tsym writing }
+        function  sym_var_value(const s:string;arg:pointer):string;
+        function  sym_stabstr_evaluate(sym:tsym;const s:string;const vars:array of string):Pchar;
+        procedure write_symtable_syms(list:taasmoutput;st:tsymtable);
+        { tdef writing }
+        function  def_stab_number(def:tdef):string;
+        function  def_stab_classnumber(def:tobjectdef):string;
+        function  def_var_value(const s:string;arg:pointer):string;
+        function  def_stabstr_evaluate(def:tdef;const s:string;const vars:array of string):Pchar;
+        procedure field_add_stabstr(p:Tnamedindexitem;arg:pointer);
+        procedure method_add_stabstr(p:Tnamedindexitem;arg:pointer);
+        function  def_stabstr(def:tdef):pchar;
+        procedure write_def_stabstr(list:taasmoutput;def:tdef);
+        procedure field_write_defs(p:Tnamedindexitem;arg:pointer);
+        procedure method_write_defs(p :tnamedindexitem;arg:pointer);
+        procedure write_symtable_defs(list:taasmoutput;st:tsymtable);
+      public
+        procedure insertsym(list:taasmoutput;sym:tsym);override;
+        procedure insertdef(list:taasmoutput;def:tdef);override;
+        procedure insertvmt(list:taasmoutput;objdef:tobjectdef);override;
+        procedure insertmoduletypes(list:taasmoutput);override;
+        procedure insertprocstart(list:taasmoutput);override;
+        procedure insertprocend(list:taasmoutput);override;
+        procedure insertmodulestart(list:taasmoutput);override;
+        procedure insertmoduleend(list:taasmoutput);override;
+        procedure insertlineinfo(list:taasmoutput);override;
+        procedure referencesections(list:taasmoutput);override;
+      end;
+
+implementation
+
+    uses
+      strings,cutils,
+      systems,globals,globtype,verbose,
+      symconst,defutil,
+      cpuinfo,cpubase,cgbase,paramgr,
+      aasmbase,procinfo,
+      finput,fmodule,ppu;
+
+    const
+      memsizeinc = 512;
+
+      N_GSYM = $20;
+      N_STSYM = 38;     { initialized const }
+      N_LCSYM = 40;     { non initialized variable}
+      N_Function = $24; { function or const }
+      N_TextLine = $44;
+      N_DataLine = $46;
+      N_BssLine = $48;
+      N_RSYM = $40;     { register variable }
+      N_LSYM = $80;
+      N_tsym = 160;
+      N_SourceFile = $64;
+      N_IncludeFile = $84;
+      N_BINCL = $82;
+      N_EINCL = $A2;
+      N_EXCL  = $C2;
+
+      tagtypes = [
+        recorddef,
+        enumdef,
+        stringdef,
+        filedef,
+        objectdef
+      ];
+
+    type
+       get_var_value_proc=function(const s:string;arg:pointer):string of object;
+
+       Trecord_stabgen_state=record
+          stabstring:Pchar;
+          stabsize,staballoc,recoffset:integer;
+       end;
+       Precord_stabgen_state=^Trecord_stabgen_state;
+
+
+    function string_evaluate(s:string;get_var_value:get_var_value_proc;
+                             get_var_value_arg:pointer;
+                             const vars:array of string):Pchar;
+
+    (*
+     S contains a prototype of a result. Stabstr_evaluate will expand
+     variables and parameters.
+
+     Output is s in ASCIIZ format, with the following expanded:
+
+     ${varname}   - The variable name is expanded.
+     $n           - The parameter n is expanded.
+     $$           - Is expanded to $
+    *)
+
+    const maxvalue=9;
+          maxdata=1023;
+
+    var i,j:byte;
+        varname:string[63];
+        varno,varcounter:byte;
+        varvalues:array[0..9] of Pstring;
+        {1 kb of parameters is the limit. 256 extra bytes are allocated to
+         ensure buffer integrity.}
+        varvaluedata:array[0..maxdata+256] of char;
+        varptr:Pchar;
+        varidx : byte;
+        len:cardinal;
+        r:Pchar;
+
+    begin
+      {Two pass approach, first, calculate the length and receive variables.}
+      i:=1;
+      len:=0;
+      varcounter:=0;
+      varptr:=@varvaluedata;
+      while i<=length(s) do
+        begin
+          if (s[i]='$') and (i<length(s)) then
+            begin
+             if s[i+1]='$' then
+               begin
+                 inc(len);
+                 inc(i);
+               end
+             else if (s[i+1]='{') and (length(s)>2) and (i<length(s)-2) then
+               begin
+                 varname:='';
+                 inc(i,2);
+                 repeat
+                   inc(varname[0]);
+                   varname[length(varname)]:=s[i];
+                   s[i]:=char(varcounter);
+                   inc(i);
+                 until s[i]='}';
+                 varvalues[varcounter]:=Pstring(varptr);
+                 if varptr>@varvaluedata+maxdata then
+                   internalerrorproc(200411152);
+                 Pstring(varptr)^:=get_var_value(varname,get_var_value_arg);
+                 inc(len,length(Pstring(varptr)^));
+                 inc(varptr,length(Pstring(varptr)^)+1);
+                 inc(varcounter);
+               end
+             else if s[i+1] in ['1'..'9'] then
+               begin
+                 varidx:=byte(s[i+1])-byte('1');
+                 if varidx>high(vars) then
+                   internalerror(200509263);
+                 inc(len,length(vars[varidx]));
+                 inc(i);
+               end;
+            end
+          else
+            inc(len);
+          inc(i);
+        end;
+
+      {Second pass, writeout result.}
+      getmem(r,len+1);
+      string_evaluate:=r;
+      i:=1;
+      while i<=length(s) do
+        begin
+          if (s[i]='$') and (i<length(s)) then
+            begin
+             if s[i+1]='$' then
+               begin
+                 r^:='$';
+                 inc(r);
+                 inc(i);
+               end
+             else if (s[i+1]='{') and (length(s)>2) and (i<length(s)-2) then
+               begin
+                 varname:='';
+                 inc(i,2);
+                 varno:=byte(s[i]);
+                 repeat
+                   inc(i);
+                 until s[i]='}';
+                 for j:=1 to length(varvalues[varno]^) do
+                   begin
+                     r^:=varvalues[varno]^[j];
+                     inc(r);
+                   end;
+               end
+             else if s[i+1] in ['0'..'9'] then
+               begin
+                 for j:=1 to length(vars[byte(s[i+1])-byte('1')]) do
+                   begin
+                     r^:=vars[byte(s[i+1])-byte('1')][j];
+                     inc(r);
+                   end;
+                 inc(i);
+               end
+            end
+          else
+            begin
+              r^:=s[i];
+              inc(r);
+            end;
+          inc(i);
+        end;
+      r^:=#0;
+    end;
+
+
+{****************************************************************************
+                               TDef support
+****************************************************************************}
+
+    function TDebugInfoStabs.def_stab_number(def:tdef):string;
+      begin
+        { procdefs only need a number, mark them as already written
+          so they won't be written implicitly }
+        if (def.deftype=procdef) then
+          def.stab_state:=stab_state_written;
+        { Stab must already be written, or we must be busy writing it }
+        if writing_def_stabs and
+           not(def.stab_state in [stab_state_writing,stab_state_written]) then
+          internalerror(200403091);
+        { Keep track of used stabs, this info is only usefull for stabs
+          referenced by the symbols. Definitions will always include all
+          required stabs }
+        if def.stab_state=stab_state_unused then
+          def.stab_state:=stab_state_used;
+        { Need a new number? }
+        if def.stab_number=0 then
+          begin
+            inc(global_stab_number);
+            { classes require 2 numbers }
+            if is_class(def) then
+              inc(global_stab_number);
+            def.stab_number:=global_stab_number;
+          end;
+        result:=tostr(def.stab_number);
+      end;
+
+
+    function TDebugInfoStabs.def_stab_classnumber(def:tobjectdef):string;
+      begin
+        if def.stab_number=0 then
+          def_stab_number(def);
+        result:=tostr(def.stab_number-1);
+      end;
+
+
+    function TDebugInfoStabs.def_var_value(const s:string;arg:pointer):string;
+      var
+        def : tdef;
+      begin
+        def:=tdef(arg);
+        result:='';
+        if s='numberstring' then
+          result:=def_stab_number(def)
+        else if s='sym_name' then
+          begin
+            if assigned(def.typesym) then
+               result:=Ttypesym(def.typesym).name;
+          end
+        else if s='N_LSYM' then
+          result:=tostr(N_LSYM)
+        else if s='savesize' then
+          result:=tostr(def.size);
+      end;
+
+
+    function TDebugInfoStabs.def_stabstr_evaluate(def:tdef;const s:string;const vars:array of string):Pchar;
+      begin
+        result:=string_evaluate(s,@def_var_value,def,vars);
+      end;
+
+
+    procedure TDebugInfoStabs.field_add_stabstr(p:Tnamedindexitem;arg:pointer);
+      var
+        newrec  : Pchar;
+        spec    : string[3];
+        varsize : aint;
+        state   : Precord_stabgen_state;
+      begin
+        state:=arg;
+        { static variables from objects are like global objects }
+        if (Tsym(p).typ=fieldvarsym) and
+           not(sp_static in Tsym(p).symoptions) then
+          begin
+            if ([sp_protected,sp_strictprotected]*tsym(p).symoptions)<>[] then
+              spec:='/1'
+            else if ([sp_private,sp_strictprivate]*tsym(p).symoptions)<>[] then
+              spec:='/0'
+            else
+              spec:='';
+            varsize:=tfieldvarsym(p).vartype.def.size;
+            { open arrays made overflows !! }
+            if varsize>$fffffff then
+              varsize:=$fffffff;
+            newrec:=def_stabstr_evaluate(nil,'$1:$2,$3,$4;',[p.name,
+                                     spec+def_stab_number(tfieldvarsym(p).vartype.def),
+                                     tostr(tfieldvarsym(p).fieldoffset*8),tostr(varsize*8)]);
+            if state^.stabsize+strlen(newrec)>=state^.staballoc-256 then
+              begin
+                inc(state^.staballoc,memsizeinc);
+                reallocmem(state^.stabstring,state^.staballoc);
+              end;
+            strcopy(state^.stabstring+state^.stabsize,newrec);
+            inc(state^.stabsize,strlen(newrec));
+            strdispose(newrec);
+            {This should be used for case !!}
+            inc(state^.recoffset,Tfieldvarsym(p).vartype.def.size);
+          end;
+      end;
+
+
+    procedure TDebugInfoStabs.method_add_stabstr(p:Tnamedindexitem;arg:pointer);
+      var virtualind,argnames : string;
+          newrec : pchar;
+          pd     : tprocdef;
+          lindex : longint;
+          arglength : byte;
+          sp : char;
+          state:^Trecord_stabgen_state;
+          olds:integer;
+          i : integer;
+          parasym : tparavarsym;
+      begin
+        state:=arg;
+        if tsym(p).typ = procsym then
+         begin
+           pd := tprocsym(p).first_procdef;
+           if (po_virtualmethod in pd.procoptions) then
+             begin
+               lindex := pd.extnumber;
+               {doesnt seem to be necessary
+               lindex := lindex or $80000000;}
+               virtualind := '*'+tostr(lindex)+';'+def_stab_classnumber(pd._class)+';'
+             end
+            else
+             virtualind := '.';
+
+            { used by gdbpas to recognize constructor and destructors }
+            if (pd.proctypeoption=potype_constructor) then
+              argnames:='__ct__'
+            else if (pd.proctypeoption=potype_destructor) then
+              argnames:='__dt__'
+            else
+              argnames := '';
+
+           { arguments are not listed here }
+           {we don't need another definition}
+            for i:=0 to pd.paras.count-1 do
+              begin
+                parasym:=tparavarsym(pd.paras[i]);
+                if Parasym.vartype.def.deftype = formaldef then
+                  begin
+                    case Parasym.varspez of
+                      vs_var :
+                        argnames := argnames+'3var';
+                      vs_const :
+                        argnames:=argnames+'5const';
+                      vs_out :
+                        argnames:=argnames+'3out';
+                    end;
+                  end
+                else
+                  begin
+                    { if the arg definition is like (v: ^byte;..
+                    there is no sym attached to data !!! }
+                    if assigned(Parasym.vartype.def.typesym) then
+                      begin
+                        arglength := length(Parasym.vartype.def.typesym.name);
+                        argnames := argnames + tostr(arglength)+Parasym.vartype.def.typesym.name;
+                      end
+                    else
+                      argnames:=argnames+'11unnamedtype';
+                  end;
+              end;
+           { here 2A must be changed for private and protected }
+           { 0 is private 1 protected and 2 public }
+           if ([sp_private,sp_strictprivate]*tsym(p).symoptions)<>[] then
+             sp:='0'
+           else if ([sp_protected,sp_strictprotected]*tsym(p).symoptions)<>[] then
+             sp:='1'
+           else
+             sp:='2';
+           newrec:=def_stabstr_evaluate(nil,'$1::$2=##$3;:$4;$5A$6;',[p.name,def_stab_number(pd),
+                                    def_stab_number(pd.rettype.def),argnames,sp,
+                                    virtualind]);
+           { get spare place for a string at the end }
+           olds:=state^.stabsize;
+           inc(state^.stabsize,strlen(newrec));
+           if state^.stabsize>=state^.staballoc-256 then
+             begin
+                inc(state^.staballoc,memsizeinc);
+                reallocmem(state^.stabstring,state^.staballoc);
+             end;
+           strcopy(state^.stabstring+olds,newrec);
+           strdispose(newrec);
+           {This should be used for case !!
+           RecOffset := RecOffset + pd.size;}
+         end;
+      end;
+
+
+    function TDebugInfoStabs.def_stabstr(def:tdef):pchar;
+
+        function stringdef_stabstr(def:tstringdef):pchar;
+          var
+            slen : aint;
+            bytest,charst,longst : string;
+          begin
+            case def.string_typ of
+              st_shortstring:
+                begin
+                  { fix length of openshortstring }
+                  slen:=def.len;
+                  if slen=0 then
+                    slen:=255;
+                  charst:=def_stab_number(cchartype.def);
+                  bytest:=def_stab_number(u8inttype.def);
+                  result:=def_stabstr_evaluate(def,'s$1length:$2,0,8;st:ar$2;1;$3;$4,8,$5;;',
+                              [tostr(slen+1),bytest,tostr(slen),charst,tostr(slen*8)]);
+                end;
+              st_longstring:
+                begin
+                  charst:=def_stab_number(cchartype.def);
+                  bytest:=def_stab_number(u8inttype.def);
+                  longst:=def_stab_number(u32inttype.def);
+                  result:=def_stabstr_evaluate(def,'s$1length:$2,0,32;dummy:$6,32,8;st:ar$2;1;$3;$4,40,$5;;',
+                              [tostr(def.len+5),longst,tostr(def.len),charst,tostr(def.len*8),bytest]);
+               end;
+             st_ansistring:
+               begin
+                 { looks like a pchar }
+                 charst:=def_stab_number(cchartype.def);
+                 result:=strpnew('*'+charst);
+               end;
+             st_widestring:
+               begin
+                 { looks like a pwidechar }
+                 charst:=def_stab_number(cwidechartype.def);
+                 result:=strpnew('*'+charst);
+               end;
+            end;
+          end;
+
+        function enumdef_stabstr(def:tenumdef):pchar;
+          var
+            st : Pchar;
+            p : Tenumsym;
+            s : string;
+            memsize,
+            stl : aint;
+          begin
+            memsize:=memsizeinc;
+            getmem(st,memsize);
+            { we can specify the size with @s<size>; prefix PM }
+            if def.size <> std_param_align then
+              strpcopy(st,'@s'+tostr(def.size*8)+';e')
+            else
+              strpcopy(st,'e');
+            p := tenumsym(def.firstenum);
+            stl:=strlen(st);
+            while assigned(p) do
+              begin
+                s :=p.name+':'+tostr(p.value)+',';
+                { place for the ending ';' also }
+                if (stl+length(s)+1>=memsize) then
+                  begin
+                    inc(memsize,memsizeinc);
+                    reallocmem(st,memsize);
+                  end;
+                strpcopy(st+stl,s);
+                inc(stl,length(s));
+                p:=p.nextenum;
+              end;
+            st[stl]:=';';
+            st[stl+1]:=#0;
+            reallocmem(st,stl+2);
+            result:=st;
+          end;
+
+        function orddef_stabstr(def:torddef):pchar;
+          begin
+            if cs_gdb_valgrind in aktglobalswitches then
+              begin
+                case def.typ of
+                  uvoid :
+                    result:=strpnew(def_stab_number(def));
+                  bool8bit,
+                  bool16bit,
+                  bool32bit :
+                    result:=def_stabstr_evaluate(def,'r${numberstring};0;255;',[]);
+                  u32bit,
+                  s64bit,
+                  u64bit :
+                    result:=def_stabstr_evaluate(def,'r${numberstring};0;-1;',[]);
+                  else
+                    result:=def_stabstr_evaluate(def,'r${numberstring};$1;$2;',[tostr(longint(def.low)),tostr(longint(def.high))]);
+                end;
+              end
+            else
+              begin
+                case def.typ of
+                  uvoid :
+                    result:=strpnew(def_stab_number(def));
+                  uchar :
+                    result:=strpnew('-20;');
+                  uwidechar :
+                    result:=strpnew('-30;');
+                  bool8bit :
+                    result:=strpnew('-21;');
+                  bool16bit :
+                    result:=strpnew('-22;');
+                  bool32bit :
+                    result:=strpnew('-23;');
+                  u64bit :
+                    result:=strpnew('-32;');
+                  s64bit :
+                    result:=strpnew('-31;');
+                  {u32bit : result:=def_stab_number(s32inttype.def)+';0;-1;'); }
+                  else
+                    result:=def_stabstr_evaluate(def,'r${numberstring};$1;$2;',[tostr(longint(def.low)),tostr(longint(def.high))]);
+                end;
+             end;
+          end;
+
+        function floatdef_stabstr(def:tfloatdef):Pchar;
+          begin
+            case def.typ of
+              s32real,
+              s64real,
+              s80real:
+                result:=def_stabstr_evaluate(def,'r$1;${savesize};0;',[def_stab_number(s32inttype.def)]);
+              s64currency,
+              s64comp:
+                result:=def_stabstr_evaluate(def,'r$1;-${savesize};0;',[def_stab_number(s32inttype.def)]);
+              else
+                internalerror(200509261);
+            end;
+          end;
+
+        function filedef_stabstr(def:tfiledef):pchar;
+          begin
+{$ifdef cpu64bit}
+            result:=def_stabstr_evaluate(def,'s${savesize}HANDLE:$1,0,32;MODE:$1,32,32;RECSIZE:$2,64,64;'+
+                                     '_PRIVATE:ar$1;1;64;$3,128,256;USERDATA:ar$1;1;16;$3,384,128;'+
+                                     'NAME:ar$1;0;255;$4,512,2048;;',[def_stab_number(s32inttype.def),
+                                     def_stab_number(s64inttype.def),
+                                     def_stab_number(u8inttype.def),
+                                     def_stab_number(cchartype.def)]);
+{$else cpu64bit}
+            result:=def_stabstr_evaluate(def,'s${savesize}HANDLE:$1,0,32;MODE:$1,32,32;RECSIZE:$1,64,32;'+
+                                     '_PRIVATE:ar$1;1;32;$3,96,256;USERDATA:ar$1;1;16;$2,352,128;'+
+                                     'NAME:ar$1;0;255;$3,480,2048;;',[def_stab_number(s32inttype.def),
+                                     def_stab_number(u8inttype.def),
+                                     def_stab_number(cchartype.def)]);
+{$endif cpu64bit}
+          end;
+
+        function procdef_stabstr(def:tprocdef):pchar;
+          Var
+            RType : Char;
+            Obj,Info : String;
+            stabsstr : string;
+            p : pchar;
+          begin
+            obj := def.procsym.name;
+            info := '';
+            if (po_global in def.procoptions) then
+              RType := 'F'
+            else
+              RType := 'f';
+            if assigned(def.owner) then
+             begin
+               if (def.owner.symtabletype = objectsymtable) then
+                 obj := def.owner.name^+'__'+def.procsym.name;
+               if not(cs_gdb_valgrind in aktglobalswitches) and
+                  (def.owner.symtabletype=localsymtable) and
+                  assigned(def.owner.defowner) and
+                  assigned(tprocdef(def.owner.defowner).procsym) then
+                 info := ','+def.procsym.name+','+tprocdef(def.owner.defowner).procsym.name;
+             end;
+            stabsstr:=def.mangledname;
+            getmem(p,length(stabsstr)+255);
+            strpcopy(p,'"'+obj+':'+RType
+                  +def_stab_number(def.rettype.def)+info+'",'+tostr(n_function)
+                  +',0,'+
+                  tostr(def.fileinfo.line)
+                  +',');
+            strpcopy(strend(p),stabsstr);
+            result:=strnew(p);
+            freemem(p,length(stabsstr)+255);
+          end;
+
+        function recorddef_stabstr(def:trecorddef):pchar;
+          var
+            state : Trecord_stabgen_state;
+          begin
+            getmem(state.stabstring,memsizeinc);
+            state.staballoc:=memsizeinc;
+            strpcopy(state.stabstring,'s'+tostr(def.size));
+            state.recoffset:=0;
+            state.stabsize:=strlen(state.stabstring);
+            def.symtable.foreach(@field_add_stabstr,@state);
+            state.stabstring[state.stabsize]:=';';
+            state.stabstring[state.stabsize+1]:=#0;
+            reallocmem(state.stabstring,state.stabsize+2);
+            result:=state.stabstring;
+          end;
+
+        function objectdef_stabstr(def:tobjectdef):pchar;
+          var
+            anc    : tobjectdef;
+            state  :Trecord_stabgen_state;
+            ts     : string;
+          begin
+            { Write the invisible pointer for the class? }
+            if (def.objecttype=odt_class) and
+               (not def.writing_class_record_stab) then
+              begin
+                result:=strpnew('*'+def_stab_classnumber(def));
+                exit;
+              end;
+
+            state.staballoc:=memsizeinc;
+            getmem(state.stabstring,state.staballoc);
+            strpcopy(state.stabstring,'s'+tostr(tobjectsymtable(def.symtable).datasize));
+            if assigned(def.childof) then
+              begin
+                {only one ancestor not virtual, public, at base offset 0 }
+                {       !1           ,    0       2         0    ,       }
+                strpcopy(strend(state.stabstring),'!1,020,'+def_stab_classnumber(def.childof)+';');
+              end;
+            {virtual table to implement yet}
+            state.recoffset:=0;
+            state.stabsize:=strlen(state.stabstring);
+            def.symtable.foreach(@field_add_stabstr,@state);
+            if (oo_has_vmt in def.objectoptions) then
+              if not assigned(def.childof) or not(oo_has_vmt in def.childof.objectoptions) then
+                 begin
+                    ts:='$vf'+def_stab_classnumber(def)+':'+def_stab_number(vmtarraytype.def)+','+tostr(def.vmt_offset*8)+';';
+                    strpcopy(state.stabstring+state.stabsize,ts);
+                    inc(state.stabsize,length(ts));
+                 end;
+            def.symtable.foreach(@method_add_stabstr,@state);
+            if (oo_has_vmt in def.objectoptions) then
+              begin
+                 anc := def;
+                 while assigned(anc.childof) and (oo_has_vmt in anc.childof.objectoptions) do
+                   anc := anc.childof;
+                 { just in case anc = self }
+                 ts:=';~%'+def_stab_classnumber(anc)+';';
+              end
+            else
+              ts:=';';
+            strpcopy(state.stabstring+state.stabsize,ts);
+            inc(state.stabsize,length(ts));
+            reallocmem(state.stabstring,state.stabsize+1);
+            result:=state.stabstring;
+          end;
+
+      begin
+        result:=nil;
+        case def.deftype of
+          stringdef :
+            result:=stringdef_stabstr(tstringdef(def));
+          enumdef :
+            result:=enumdef_stabstr(tenumdef(def));
+          orddef :
+            result:=orddef_stabstr(torddef(def));
+          floatdef :
+            result:=floatdef_stabstr(tfloatdef(def));
+          filedef :
+            result:=filedef_stabstr(tfiledef(def));
+          recorddef :
+            result:=recorddef_stabstr(trecorddef(def));
+          variantdef :
+            result:=def_stabstr_evaluate(def,'formal${numberstring};',[]);
+          pointerdef :
+            result:=strpnew('*'+def_stab_number(tpointerdef(def).pointertype.def));
+          classrefdef :
+            result:=strpnew(def_stab_number(pvmttype.def));
+          setdef :
+            result:=def_stabstr_evaluate(def,'@s$1;S$2',[tostr(def.size*8),def_stab_number(tsetdef(def).elementtype.def)]);
+          formaldef :
+            result:=def_stabstr_evaluate(def,'formal${numberstring};',[]);
+          arraydef :
+            result:=def_stabstr_evaluate(def,'ar$1;$2;$3;$4',[def_stab_number(tarraydef(def).rangetype.def),
+               tostr(tarraydef(def).lowrange),tostr(tarraydef(def).highrange),def_stab_number(tarraydef(def).elementtype.def)]);
+          procdef :
+            result:=procdef_stabstr(tprocdef(def));
+          procvardef :
+            result:=strpnew('*f'+def_stab_number(tprocvardef(def).rettype.def));
+          objectdef :
+            begin
+              if tobjectdef(def).writing_class_record_stab then
+                result:=objectdef_stabstr(tobjectdef(def))
+              else
+                result:=strpnew('*'+def_stab_classnumber(tobjectdef(def)));
+            end;
+        end;
+      end;
+
+
+    procedure TDebugInfoStabs.write_def_stabstr(list:taasmoutput;def:tdef);
+      var
+        stabchar : string[2];
+        ss,st,su : pchar;
+      begin
+        { procdefs require a different stabs style, handle them separately }
+        if def.deftype<>procdef then
+          begin
+            { type prefix }
+            if def.deftype in tagtypes then
+              stabchar := 'Tt'
+            else
+              stabchar := 't';
+            { Here we maybe generate a type, so we have to use numberstring }
+            if is_class(def) and
+               tobjectdef(def).writing_class_record_stab then
+              st:=def_stabstr_evaluate(def,'"${sym_name}:$1$2=',[stabchar,def_stab_classnumber(tobjectdef(def))])
+            else
+              st:=def_stabstr_evaluate(def,'"${sym_name}:$1$2=',[stabchar,def_stab_number(def)]);
+            ss:=def_stabstr(def);
+            reallocmem(st,strlen(ss)+512);
+            { line info is set to 0 for all defs, because the def can be in an other
+              unit and then the linenumber is invalid in the current sourcefile }
+            su:=def_stabstr_evaluate(def,'",${N_LSYM},0,0,0',[]);
+            strcopy(strecopy(strend(st),ss),su);
+            reallocmem(st,strlen(st)+1);
+            strdispose(ss);
+            strdispose(su);
+          end
+        else
+          st:=def_stabstr(def);
+        { add to list }
+        list.concat(Tai_stab.create(stab_stabs,st));
+      end;
+
+
+    procedure TDebugInfoStabs.field_write_defs(p:Tnamedindexitem;arg:pointer);
+      begin
+        if (Tsym(p).typ=fieldvarsym) and
+           not(sp_static in Tsym(p).symoptions) then
+          insertdef(taasmoutput(arg),tfieldvarsym(p).vartype.def);
+      end;
+
+
+    procedure TDebugInfoStabs.method_write_defs(p :tnamedindexitem;arg:pointer);
+      var
+        pd : tprocdef;
+      begin
+        if tsym(p).typ = procsym then
+          begin
+            pd:=tprocsym(p).first_procdef;
+            insertdef(taasmoutput(arg),pd.rettype.def);
+          end;
+      end;
+
+
+    procedure TDebugInfoStabs.insertdef(list:taasmoutput;def:tdef);
+      var
+        anc : tobjectdef;
+        oldtypesym : tsym;
+//        nb  : string[12];
+      begin
+        if (def.stab_state in [stab_state_writing,stab_state_written]) then
+          exit;
+        { to avoid infinite loops }
+        def.stab_state := stab_state_writing;
+        { write dependencies first }
+        case def.deftype of
+          stringdef :
+            begin
+              if tstringdef(def).string_typ=st_widestring then
+                insertdef(list,cwidechartype.def)
+              else
+                begin
+                  insertdef(list,cchartype.def);
+                  insertdef(list,u8inttype.def);
+                end;
+            end;
+          floatdef :
+            insertdef(list,s32inttype.def);
+          filedef :
+            begin
+              insertdef(list,s32inttype.def);
+{$ifdef cpu64bit}
+              insertdef(list,s64inttype.def);
+{$endif cpu64bit}
+              insertdef(list,u8inttype.def);
+              insertdef(list,cchartype.def);
+            end;
+          classrefdef,
+          pointerdef :
+            insertdef(list,tpointerdef(def).pointertype.def);
+          setdef :
+            insertdef(list,tsetdef(def).elementtype.def);
+          procvardef,
+          procdef :
+            insertdef(list,tprocdef(def).rettype.def);
+          arraydef :
+            begin
+              insertdef(list,tarraydef(def).rangetype.def);
+              insertdef(list,tarraydef(def).elementtype.def);
+            end;
+          recorddef :
+            trecorddef(def).symtable.foreach(@field_write_defs,list);
+          objectdef :
+            begin
+              insertdef(list,vmtarraytype.def);
+              { first the parents }
+              anc:=tobjectdef(def);
+              while assigned(anc.childof) do
+                begin
+                  anc:=anc.childof;
+                  insertdef(list,anc);
+                end;
+              tobjectdef(def).symtable.foreach(@field_write_defs,list);
+              tobjectdef(def).symtable.foreach(@method_write_defs,list);
+            end;
+        end;
+(*
+        { Handle pointerdefs to records and objects to avoid recursion }
+        if (def.deftype=pointerdef) and
+           (tpointerdef(def).pointertype.def.deftype in [recorddef,objectdef]) then
+          begin
+            def.stab_state:=stab_state_used;
+            write_def_stabstr(list,def);
+            {to avoid infinite recursion in record with next-like fields }
+            if tdef(tpointerdef(def).pointertype.def).stab_state=stab_state_writing then
+              begin
+                if assigned(tpointerdef(def).pointertype.def.typesym) then
+                  begin
+                    if is_class(tpointerdef(def).pointertype.def) then
+                      nb:=def_stab_classnumber(tobjectdef(tpointerdef(def).pointertype.def))
+                    else
+                      nb:=def_stab_number(tpointerdef(def).pointertype.def);
+                    list.concat(Tai_stab.create(stab_stabs,def_stabstr_evaluate(
+                            def,'"${sym_name}:t${numberstring}=*$1=xs$2:",${N_LSYM},0,0,0',
+                            [nb,tpointerdef(def).pointertype.def.typesym.name])));
+                  end;
+                def.stab_state:=stab_state_written;
+              end
+          end
+        else
+*)
+        { classes require special code to write the record and the invisible pointer }
+          if is_class(def) then
+            begin
+              { Write the record class itself }
+              tobjectdef(def).writing_class_record_stab:=true;
+              write_def_stabstr(list,def);
+              tobjectdef(def).writing_class_record_stab:=false;
+              { Write the invisible pointer class }
+              oldtypesym:=def.typesym;
+              def.typesym:=nil;
+              write_def_stabstr(list,def);
+              def.typesym:=oldtypesym;
+            end
+        { normal def }
+        else
+          write_def_stabstr(list,def);
+
+        def.stab_state := stab_state_written;
+      end;
+
+
+    procedure TDebugInfoStabs.write_symtable_defs(list:taasmoutput;st:tsymtable);
+
+       procedure dowritestabs(list:taasmoutput;st:tsymtable);
+         var
+           p : tdef;
+         begin
+           p:=tdef(st.defindex.first);
+           while assigned(p) do
+             begin
+               { also insert local types for the current unit }
+               if st.iscurrentunit then
+                 begin
+                   case p.deftype of
+                     procdef :
+                       if assigned(tprocdef(p).localst) then
+                         dowritestabs(list,tprocdef(p).localst);
+                     objectdef :
+                       dowritestabs(list,tobjectdef(p).symtable);
+                   end;
+                 end;
+               if (p.stab_state=stab_state_used) then
+                 insertdef(list,p);
+               p:=tdef(p.indexnext);
+             end;
+         end;
+
+      var
+        old_writing_def_stabs : boolean;
+      begin
+        if st.symtabletype=globalsymtable then
+          list.concat(tai_comment.Create(strpnew('Begin unit '+st.name^+' has index '+tostr(st.moduleid))));
+        old_writing_def_stabs:=writing_def_stabs;
+        writing_def_stabs:=true;
+        dowritestabs(list,st);
+        writing_def_stabs:=old_writing_def_stabs;
+        if st.symtabletype=globalsymtable then
+          list.concat(tai_comment.Create(strpnew('End unit '+st.name^+' has index '+tostr(st.moduleid))));
+      end;
+
+
+{****************************************************************************
+                               TSym support
+****************************************************************************}
+
+    function TDebugInfoStabs.sym_var_value(const s:string;arg:pointer):string;
+      var
+        sym : tsym;
+      begin
+        sym:=tsym(arg);
+        result:='';
+        if s='name' then
+          result:=sym.name
+        else if s='mangledname' then
+          result:=sym.mangledname
+        else if s='ownername' then
+          result:=sym.owner.name^
+        else if s='line' then
+          result:=tostr(sym.fileinfo.line)
+        else if s='N_LSYM' then
+          result:=tostr(N_LSYM)
+        else if s='N_LCSYM' then
+          result:=tostr(N_LCSYM)
+        else if s='N_RSYM' then
+          result:=tostr(N_RSYM)
+        else if s='N_TSYM' then
+          result:=tostr(N_TSYM)
+        else if s='N_STSYM' then
+          result:=tostr(N_STSYM)
+        else if s='N_FUNCTION' then
+          result:=tostr(N_FUNCTION)
+        else
+          internalerror(200401152);
+      end;
+
+
+    function TDebugInfoStabs.sym_stabstr_evaluate(sym:tsym;const s:string;const vars:array of string):Pchar;
+      begin
+        result:=string_evaluate(s,@sym_var_value,sym,vars);
+      end;
+
+
+    procedure TDebugInfoStabs.insertsym(list:taasmoutput;sym:tsym);
+
+        function fieldvarsym_stabstr(sym:tfieldvarsym):Pchar;
+          begin
+            result:=nil;
+            if (sym.owner.symtabletype=objectsymtable) and
+               (sp_static in sym.symoptions) then
+              result:=sym_stabstr_evaluate(sym,'"${ownername}__${name}:S$1",${N_LCSYM},0,${line},${mangledname}',
+                  [def_stab_number(sym.vartype.def)]);
+          end;
+
+        function globalvarsym_stabstr(sym:tglobalvarsym):Pchar;
+          var
+            st : string;
+            threadvaroffset : string;
+            regidx : Tregisterindex;
+          begin
+            result:=nil;
+            st:=def_stab_number(sym.vartype.def);
+            case sym.localloc.loc of
+              LOC_REGISTER,
+              LOC_CREGISTER,
+              LOC_MMREGISTER,
+              LOC_CMMREGISTER,
+              LOC_FPUREGISTER,
+              LOC_CFPUREGISTER :
+                begin
+                  regidx:=findreg_by_number(sym.localloc.register);
+                  { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
+                  { this is the register order for GDB}
+                  if regidx<>0 then
+                    result:=sym_stabstr_evaluate(sym,'"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(regstabs_table[regidx])]);
+                end;
+              else
+                begin
+                  if (vo_is_thread_var in sym.varoptions) then
+                    threadvaroffset:='+'+tostr(sizeof(aint))
+                  else
+                    threadvaroffset:='';
+                  { Here we used S instead of
+                    because with G GDB doesn't look at the address field
+                    but searches the same name or with a leading underscore
+                    but these names don't exist in pascal !}
+                  st:='S'+st;
+                  result:=sym_stabstr_evaluate(sym,'"${name}:$1",${N_LCSYM},0,${line},${mangledname}$2',[st,threadvaroffset]);
+                end;
+            end;
+          end;
+
+        function localvarsym_stabstr(sym:tlocalvarsym):Pchar;
+          var
+            st : string;
+            regidx : Tregisterindex;
+          begin
+            result:=nil;
+            { There is no space allocated for not referenced locals }
+            if (sym.owner.symtabletype=localsymtable) and (sym.refs=0) then
+              exit;
+
+            st:=def_stab_number(sym.vartype.def);
+            case sym.localloc.loc of
+              LOC_REGISTER,
+              LOC_CREGISTER,
+              LOC_MMREGISTER,
+              LOC_CMMREGISTER,
+              LOC_FPUREGISTER,
+              LOC_CFPUREGISTER :
+                begin
+                  regidx:=findreg_by_number(sym.localloc.register);
+                  { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
+                  { this is the register order for GDB}
+                  if regidx<>0 then
+                    result:=sym_stabstr_evaluate(sym,'"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(regstabs_table[regidx])]);
+                end;
+              LOC_REFERENCE :
+                { offset to ebp => will not work if the framepointer is esp
+                  so some optimizing will make things harder to debug }
+                result:=sym_stabstr_evaluate(sym,'"${name}:$1",${N_TSYM},0,${line},$2',[st,tostr(sym.localloc.reference.offset)])
+              else
+                internalerror(2003091814);
+            end;
+          end;
+
+        function paravarsym_stabstr(sym:tparavarsym):Pchar;
+          var
+            st : string;
+            regidx : Tregisterindex;
+            c : char;
+          begin
+            result:=nil;
+            { set loc to LOC_REFERENCE to get somewhat usable debugging info for -Or }
+            { while stabs aren't adapted for regvars yet                             }
+            if (vo_is_self in sym.varoptions) then
+              begin
+                case sym.localloc.loc of
+                  LOC_REGISTER,
+                  LOC_CREGISTER:
+                    regidx:=findreg_by_number(sym.localloc.register);
+                  LOC_REFERENCE: ;
+                  else
+                    internalerror(2003091815);
+                end;
+                if (po_classmethod in current_procinfo.procdef.procoptions) or
+                   (po_staticmethod in current_procinfo.procdef.procoptions) then
+                  begin
+                    if (sym.localloc.loc=LOC_REFERENCE) then
+                      result:=sym_stabstr_evaluate(sym,'"pvmt:p$1",${N_TSYM},0,0,$2',
+                        [def_stab_number(pvmttype.def),tostr(sym.localloc.reference.offset)]);
+      (*            else
+                      result:=sym_stabstr_evaluate(sym,'"pvmt:r$1",${N_RSYM},0,0,$2',
+                        [def_stab_number(pvmttype.def),tostr(regstabs_table[regidx])]) *)
+                    end
+                else
+                  begin
+                    if not(is_class(current_procinfo.procdef._class)) then
+                      c:='v'
+                    else
+                      c:='p';
+                    if (sym.localloc.loc=LOC_REFERENCE) then
+                      result:=sym_stabstr_evaluate(sym,'"$$t:$1",${N_TSYM},0,0,$2',
+                            [c+def_stab_number(current_procinfo.procdef._class),tostr(sym.localloc.reference.offset)]);
+      (*            else
+                      result:=sym_stabstr_evaluate(sym,'"$$t:r$1",${N_RSYM},0,0,$2',
+                            [c+def_stab_number(current_procinfo.procdef._class),tostr(regstabs_table[regidx])]); *)
+                  end;
+              end
+            else
+              begin
+                st:=def_stab_number(sym.vartype.def);
+
+                if paramanager.push_addr_param(sym.varspez,sym.vartype.def,tprocdef(sym.owner.defowner).proccalloption) and
+                   not(vo_has_local_copy in sym.varoptions) and
+                   not is_open_string(sym.vartype.def) then
+                  st := 'v'+st { should be 'i' but 'i' doesn't work }
+                else
+                  st := 'p'+st;
+                case sym.localloc.loc of
+                  LOC_REGISTER,
+                  LOC_CREGISTER,
+                  LOC_MMREGISTER,
+                  LOC_CMMREGISTER,
+                  LOC_FPUREGISTER,
+                  LOC_CFPUREGISTER :
+                    begin
+                      regidx:=findreg_by_number(sym.localloc.register);
+                      { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
+                      { this is the register order for GDB}
+                      if regidx<>0 then
+                        result:=sym_stabstr_evaluate(sym,'"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(longint(regstabs_table[regidx]))]);
+                    end;
+                  LOC_REFERENCE :
+                    { offset to ebp => will not work if the framepointer is esp
+                      so some optimizing will make things harder to debug }
+                    result:=sym_stabstr_evaluate(sym,'"${name}:$1",${N_TSYM},0,${line},$2',[st,tostr(sym.localloc.reference.offset)])
+                  else
+                    internalerror(2003091814);
+                end;
+              end;
+          end;
+
+        function constsym_stabstr(sym:tconstsym):Pchar;
+          var
+            st : string;
+          begin
+            case sym.consttyp of
+              conststring:
+                st:='s'''+backspace_quote(octal_quote(strpas(pchar(sym.value.valueptr)),[#0..#9,#11,#12,#14..#31,'''']),['"','\',#10,#13])+'''';
+              constord:
+                st:='i'+tostr(sym.value.valueord);
+              constpointer:
+                st:='i'+tostr(sym.value.valueordptr);
+              constreal:
+                begin
+                  system.str(pbestreal(sym.value.valueptr)^,st);
+                  st := 'r'+st;
+                end;
+              else
+                begin
+                  { if we don't know just put zero !! }
+                  st:='i0';
+                end;
+            end;
+            { valgrind does not support constants }
+            if cs_gdb_valgrind in aktglobalswitches then
+              result:=nil
+            else
+              result:=sym_stabstr_evaluate(sym,'"${name}:c=$1;",${N_FUNCTION},0,${line},0',[st]);
+          end;
+
+        function typesym_stabstr(sym:ttypesym) : pchar;
+          var
+            stabchar : string[2];
+          begin
+            result:=nil;
+            if not assigned(sym.restype.def) then
+              internalerror(200509262);
+            if sym.restype.def.deftype in tagtypes then
+              stabchar:='Tt'
+            else
+              stabchar:='t';
+            result:=sym_stabstr_evaluate(sym,'"${name}:$1$2",${N_LSYM},0,${line},0',[stabchar,def_stab_number(sym.restype.def)]);
+          end;
+
+      var
+        stabstr : Pchar;
+      begin
+        stabstr:=nil;
+        case sym.typ of
+          labelsym :
+            stabstr:=sym_stabstr_evaluate(sym,'"${name}",${N_LSYM},0,${line},0',[]);
+          procsym :
+            internalerror(200111171);
+          fieldvarsym :
+            stabstr:=fieldvarsym_stabstr(tfieldvarsym(sym));
+          globalvarsym :
+            stabstr:=globalvarsym_stabstr(tglobalvarsym(sym));
+          localvarsym :
+            stabstr:=localvarsym_stabstr(tlocalvarsym(sym));
+          paravarsym :
+            stabstr:=paravarsym_stabstr(tparavarsym(sym));
+          typedconstsym :
+            stabstr:=sym_stabstr_evaluate(sym,'"${name}:S$1",${N_STSYM},0,${line},${mangledname}',
+                [def_stab_number(ttypedconstsym(sym).typedconsttype.def)]);
+          constsym :
+            stabstr:=constsym_stabstr(tconstsym(sym));
+          typesym :
+            stabstr:=typesym_stabstr(ttypesym(sym));
+        end;
+        if stabstr<>nil then
+          list.concat(Tai_stab.create(stab_stabs,stabstr));
+        sym.isstabwritten:=true;
+      end;
+
+
+    procedure TDebugInfoStabs.write_symtable_syms(list:taasmoutput;st:tsymtable);
+      var
+        p : tsym;
+      begin
+        p:=tsym(st.symindex.first);
+        while assigned(p) do
+          begin
+            { Procsym and typesym are already written }
+            if not(Tsym(p).typ in [procsym,typesym]) then
+              begin
+                if not Tsym(p).isstabwritten then
+                  insertsym(list,tsym(p));
+              end;
+            p:=tsym(p.indexnext);
+          end;
+      end;
+
+{****************************************************************************
+                             Proc/Module support
+****************************************************************************}
+
+    procedure tdebuginfostabs.insertvmt(list:taasmoutput;objdef:tobjectdef);
+      begin
+        if assigned(objdef.owner) and
+           assigned(objdef.owner.name) then
+          list.concat(Tai_stab.create(stab_stabs,strpnew('"vmt_'+objdef.owner.name^+objdef.name+':S'+
+                 def_stab_number(vmttype.def)+'",'+tostr(N_STSYM)+',0,0,'+objdef.vmt_mangledname)));
+      end;
+
+
+    procedure tdebuginfostabs.insertmoduletypes(list:taasmoutput);
+
+       procedure reset_unit_type_info;
+       var
+         hp : tmodule;
+       begin
+         hp:=tmodule(loaded_units.first);
+         while assigned(hp) do
+           begin
+             hp.is_stab_written:=false;
+             hp:=tmodule(hp.next);
+           end;
+       end;
+
+       procedure write_used_unit_type_info(list:taasmoutput;hp:tmodule);
+       var
+         pu : tused_unit;
+       begin
+         pu:=tused_unit(hp.used_units.first);
+         while assigned(pu) do
+           begin
+             if not pu.u.is_stab_written then
+               begin
+                 { prevent infinte loop for circular dependencies }
+                 pu.u.is_stab_written:=true;
+                 { write type info from used units, use a depth first
+                   strategy to reduce the recursion in writing all
+                   dependent stabs }
+                 write_used_unit_type_info(list,pu.u);
+                 if assigned(pu.u.globalsymtable) then
+                   write_symtable_defs(list,pu.u.globalsymtable);
+               end;
+             pu:=tused_unit(pu.next);
+           end;
+       end;
+
+      var
+        temptypestabs : taasmoutput;
+        storefilepos : tfileposinfo;
+        st : tsymtable;
+      begin
+        global_stab_number:=0;
+
+        storefilepos:=aktfilepos;
+        aktfilepos:=current_module.mainfilepos;
+        { include symbol that will be referenced from the program to be sure to
+          include this debuginfo .o file }
+        if current_module.is_unit then
+          begin
+            current_module.flags:=current_module.flags or uf_has_debuginfo;
+            st:=current_module.globalsymtable;
+          end
+        else
+          st:=current_module.localsymtable;
+        new_section(list,sec_data,st.name^,0);
+        list.concat(tai_symbol.Createname_global(make_mangledname('DEBUGINFO',st,''),AT_DATA,0));
+        { first write all global/local symbols again to a temp list. This will flag
+          all required tdefs. After that the temp list can be removed since the debuginfo is already
+          written to the stabs when the variables/consts were written }
+{$warning Hack to get all needed types}
+        temptypestabs:=taasmoutput.create;
+        if assigned(current_module.globalsymtable) then
+          write_symtable_syms(temptypestabs,current_module.globalsymtable);
+        if assigned(current_module.localsymtable) then
+          write_symtable_syms(temptypestabs,current_module.localsymtable);
+        temptypestabs.free;
+        { reset unit type info flag }
+        reset_unit_type_info;
+        { write used types from the used units }
+        write_used_unit_type_info(list,current_module);
+        { last write the types from this unit }
+        if assigned(current_module.globalsymtable) then
+          write_symtable_defs(list,current_module.globalsymtable);
+        if assigned(current_module.localsymtable) then
+          write_symtable_defs(list,current_module.localsymtable);
+        aktfilepos:=storefilepos;
+      end;
+
+
+    procedure tdebuginfostabs.insertlineinfo(list:taasmoutput);
+      var
+        currfileinfo,
+        lastfileinfo : tfileposinfo;
+        currfuncname : pstring;
+        currsectype  : tasmsectiontype;
+        hlabel       : tasmlabel;
+        hp : tai;
+        infile : tinputfile;
+      begin
+        FillChar(lastfileinfo,sizeof(lastfileinfo),0);
+        currfuncname:=nil;
+        currsectype:=sec_code;
+        hp:=Tai(list.first);
+        while assigned(hp) do
+          begin
+            case hp.typ of
+              ait_section :
+                currsectype:=tai_section(hp).sectype;
+              ait_function_name :
+                currfuncname:=tai_function_name(hp).funcname;
+              ait_force_line :
+                lastfileinfo.line:=-1;
+            end;
+
+            if (currsectype=sec_code) and
+               (hp.typ=ait_instruction) then
+              begin
+                currfileinfo:=tailineinfo(hp).fileinfo;
+                { file changed ? (must be before line info) }
+                if (currfileinfo.fileindex<>0) and
+                   (lastfileinfo.fileindex<>currfileinfo.fileindex) then
+                  begin
+                    infile:=current_module.sourcefiles.get_file(currfileinfo.fileindex);
+                    if assigned(infile) then
+                      begin
+                        objectlibrary.getlabel(hlabel,alt_dbgfile);
+                        { emit stabs }
+                        if (infile.path^<>'') then
+                          list.insertbefore(Tai_stab.Create_str(stab_stabs,'"'+BsToSlash(FixPath(infile.path^,false))+'",'+tostr(n_includefile)+
+                                            ',0,0,'+hlabel.name),hp);
+                        list.insertbefore(Tai_stab.Create_str(stab_stabs,'"'+FixFileName(infile.name^)+'",'+tostr(n_includefile)+
+                                          ',0,0,'+hlabel.name),hp);
+                        list.insertbefore(tai_label.create(hlabel),hp);
+                        { force new line info }
+                        lastfileinfo.line:=-1;
+                      end;
+                  end;
+
+                { line changed ? }
+                if (lastfileinfo.line<>currfileinfo.line) and (currfileinfo.line<>0) then
+                  begin
+                     if assigned(currfuncname) and
+                        (target_info.use_function_relative_addresses) then
+                      begin
+                        objectlibrary.getlabel(hlabel,alt_dbgline);
+                        list.insertbefore(Tai_stab.Create_str(stab_stabn,tostr(n_textline)+',0,'+tostr(currfileinfo.line)+','+
+                                          hlabel.name+' - '+{$IFDEF POWERPC64}'.'+{$ENDIF POWERPC64}currfuncname^),hp);
+                        list.insertbefore(tai_label.create(hlabel),hp);
+                      end
+                     else
+                      list.insertbefore(Tai_stab.Create_str(stab_stabd,tostr(n_textline)+',0,'+tostr(currfileinfo.line)),hp);
+                  end;
+                lastfileinfo:=currfileinfo;
+              end;
+
+            hp:=tai(hp.next);
+          end;
+      end;
+
+
+    procedure tdebuginfostabs.insertprocstart(list:taasmoutput);
+      begin
+        insertdef(list,current_procinfo.procdef);
+        Tprocsym(current_procinfo.procdef.procsym).isstabwritten:=true;
+        { write local symtables }
+        if not(po_external in current_procinfo.procdef.procoptions) then
+          begin
+            if assigned(current_procinfo.procdef.parast) then
+              write_symtable_syms(list,current_procinfo.procdef.parast);
+            { local type defs and vars should not be written
+              inside the main proc stab }
+            if assigned(current_procinfo.procdef.localst) and
+               (current_procinfo.procdef.localst.symtabletype=localsymtable) then
+              write_symtable_syms(list,current_procinfo.procdef.localst);
+          end;
+      end;
+
+
+    procedure tdebuginfostabs.insertprocend(list:taasmoutput);
+      var
+        stabsendlabel : tasmlabel;
+        mangled_length : longint;
+        p : pchar;
+        hs : string;
+      begin
+        objectlibrary.getlabel(stabsendlabel,alt_dbgtype);
+        list.concat(tai_label.create(stabsendlabel));
+
+        if assigned(current_procinfo.procdef.funcretsym) and
+           (tabstractnormalvarsym(current_procinfo.procdef.funcretsym).refs>0) then
+          begin
+            if tabstractnormalvarsym(current_procinfo.procdef.funcretsym).localloc.loc=LOC_REFERENCE then
+              begin
+{$warning Need to add gdb support for ret in param register calling}
+                if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
+                  hs:='X*'
+                else
+                  hs:='X';
+                list.concat(Tai_stab.create(stab_stabs,strpnew(
+                   '"'+current_procinfo.procdef.procsym.name+':'+hs+def_stab_number(current_procinfo.procdef.rettype.def)+'",'+
+                   tostr(N_tsym)+',0,0,'+tostr(tabstractnormalvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
+                if (m_result in aktmodeswitches) then
+                  list.concat(Tai_stab.create(stab_stabs,strpnew(
+                     '"RESULT:'+hs+def_stab_number(current_procinfo.procdef.rettype.def)+'",'+
+                     tostr(N_tsym)+',0,0,'+tostr(tabstractnormalvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
+              end;
+          end;
+        mangled_length:=length(current_procinfo.procdef.mangledname);
+        getmem(p,2*mangled_length+50);
+        strpcopy(p,'192,0,0,');
+        {$IFDEF POWERPC64}strpcopy(strend(p), '.');{$ENDIF POWERPC64}
+        strpcopy(strend(p),current_procinfo.procdef.mangledname);
+        if (target_info.use_function_relative_addresses) then
+          begin
+            strpcopy(strend(p),'-');
+            {$IFDEF POWERPC64}strpcopy(strend(p), '.');{$ENDIF POWERPC64}
+            strpcopy(strend(p),current_procinfo.procdef.mangledname);
+          end;
+        list.concat(Tai_stab.Create(stab_stabn,strnew(p)));
+        strpcopy(p,'224,0,0,'+stabsendlabel.name);
+        if (target_info.use_function_relative_addresses) then
+          begin
+            strpcopy(strend(p),'-');
+            {$IFDEF POWERPC64}strpcopy(strend(p), '.');{$ENDIF POWERPC64}
+            strpcopy(strend(p),current_procinfo.procdef.mangledname);
+          end;
+        list.concat(Tai_stab.Create(stab_stabn,strnew(p)));
+        freemem(p,2*mangled_length+50);
+      end;
+
+
+    procedure tdebuginfostabs.insertmodulestart(list:taasmoutput);
+      var
+        hlabel : tasmlabel;
+        infile : tinputfile;
+        templist:taasmoutput;
+      begin
+        { emit main source n_sourcefile }
+        objectlibrary.getlabel(hlabel,alt_dbgfile);
+        infile:=current_module.sourcefiles.get_file(1);
+        templist:=taasmoutput.create;
+        new_section(templist,sec_code,'',0);
+        if (infile.path^<>'') then
+          templist.concat(Tai_stab.Create_str(stab_stabs,'"'+BsToSlash(FixPath(infile.path^,false))+'",'+tostr(n_sourcefile)+
+                      ',0,0,'+hlabel.name));
+        templist.concat(Tai_stab.Create_str(stab_stabs,'"'+FixFileName(infile.name^)+'",'+tostr(n_sourcefile)+
+                    ',0,0,'+hlabel.name));
+        templist.concat(tai_label.create(hlabel));
+        list.insertlist(templist);
+        templist.free;
+      end;
+
+
+    procedure tdebuginfostabs.insertmoduleend(list:taasmoutput);
+      var
+        hlabel : tasmlabel;
+        templist:taasmoutput;
+      begin
+        { emit empty n_sourcefile }
+        objectlibrary.getlabel(hlabel,alt_dbgfile);
+        templist:=taasmoutput.create;
+        new_section(templist,sec_code,'',0);
+        templist.concat(Tai_stab.Create_str(stab_stabs,'"",'+tostr(n_sourcefile)+',0,0,'+hlabel.name));
+        templist.concat(tai_label.create(hlabel));
+        list.insertlist(templist);
+        templist.free;
+      end;
+
+
+    procedure tdebuginfostabs.referencesections(list:taasmoutput);
+      var
+        hp   : tused_unit;
+      begin
+        { Reference all DEBUGINFO sections from the main .text section }
+        if (target_info.system <> system_powerpc_macos) then
+          begin
+            { include reference to all debuginfo sections of used units }
+            hp:=tused_unit(usedunits.first);
+            while assigned(hp) do
+              begin
+                If (hp.u.flags and uf_has_debuginfo)=uf_has_debuginfo then
+                  list.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',hp.u.globalsymtable,''),AT_DATA,0));
+                hp:=tused_unit(hp.next);
+              end;
+            { include reference to debuginfo for this program }
+            list.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',current_module.localsymtable,''),AT_DATA,0));
+          end;
+      end;
+
+
+    const
+      dbg_stabs_info : tdbginfo =
+         (
+           id     : dbg_stabs;
+           idtxt  : 'STABS';
+         );
+
+initialization
+  RegisterDebugInfo(dbg_stabs_info,TDebugInfoStabs);
+end.

compiler/powerpc64/cgcpu.pas

@@ -0,0 +1,1626 @@
+{
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    This unit implements the code generator for the PowerPC
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    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.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit cgcpu;
+
+{$I fpcdefs.inc}
+
+interface
+
+uses
+  globtype, symtype, symdef,
+  cgbase, cgobj,
+  aasmbase, aasmcpu, aasmtai,
+  cpubase, cpuinfo, cgutils, rgcpu,
+  parabase;
+
+type
+  tcgppc = class(tcg)
+    procedure init_register_allocators; override;
+    procedure done_register_allocators; override;
+
+    { passing parameters, per default the parameter is pushed }
+    { nr gives the number of the parameter (enumerated from   }
+    { left to right), this allows to move the parameter to    }
+    { register, if the cpu supports register calling          }
+    { conventions                                             }
+    procedure a_param_const(list: taasmoutput; size: tcgsize; a: aint; const
+      paraloc: tcgpara); override;
+    procedure a_param_ref(list: taasmoutput; size: tcgsize; const r: treference;
+      const paraloc: tcgpara); override;
+    procedure a_paramaddr_ref(list: taasmoutput; const r: treference; const
+      paraloc: tcgpara); override;
+
+    procedure a_call_name(list: taasmoutput; const s: string); override;
+        procedure a_call_name_direct(list: taasmoutput; s: string; prependDot : boolean);
+
+    procedure a_call_reg(list: taasmoutput; reg: tregister); override;
+
+    procedure a_op_const_reg(list: taasmoutput; Op: TOpCG; size: TCGSize; a:
+      aint; reg: TRegister); override;
+    procedure a_op_reg_reg(list: taasmoutput; Op: TOpCG; size: TCGSize; src,
+      dst: TRegister); override;
+
+    procedure a_op_const_reg_reg(list: taasmoutput; op: TOpCg;
+      size: tcgsize; a: aint; src, dst: tregister); override;
+    procedure a_op_reg_reg_reg(list: taasmoutput; op: TOpCg;
+      size: tcgsize; src1, src2, dst: tregister); override;
+
+    { move instructions }
+    procedure a_load_const_reg(list: taasmoutput; size: tcgsize; a: aint; reg:
+      tregister); override;
+    procedure a_load_reg_ref(list: taasmoutput; fromsize, tosize: tcgsize; reg:
+      tregister; const ref: treference); override;
+    procedure a_load_ref_reg(list: taasmoutput; fromsize, tosize: tcgsize; const
+      Ref: treference; reg: tregister); override;
+    procedure a_load_reg_reg(list: taasmoutput; fromsize, tosize: tcgsize; reg1,
+      reg2: tregister); override;
+
+    { fpu move instructions }
+    procedure a_loadfpu_reg_reg(list: taasmoutput; size: tcgsize; reg1, reg2:
+      tregister); override;
+    procedure a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref:
+      treference; reg: tregister); override;
+    procedure a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg:
+      tregister; const ref: treference); override;
+
+    {  comparison operations }
+    procedure a_cmp_const_reg_label(list: taasmoutput; size: tcgsize; cmp_op:
+      topcmp; a: aint; reg: tregister;
+      l: tasmlabel); override;
+    procedure a_cmp_reg_reg_label(list: taasmoutput; size: tcgsize; cmp_op:
+      topcmp; reg1, reg2: tregister; l: tasmlabel); override;
+
+    procedure a_jmp_name(list: taasmoutput; const s: string); override;
+    procedure a_jmp_always(list: taasmoutput; l: tasmlabel); override;
+    procedure a_jmp_flags(list: taasmoutput; const f: TResFlags; l: tasmlabel);
+      override;
+
+    procedure g_flags2reg(list: taasmoutput; size: TCgSize; const f: TResFlags;
+      reg: TRegister); override;
+
+    procedure g_proc_entry(list: taasmoutput; localsize: longint; nostackframe:
+      boolean); override;
+    procedure g_proc_exit(list: taasmoutput; parasize: longint; nostackframe:
+      boolean); override;
+    procedure g_save_standard_registers(list: Taasmoutput); override;
+    procedure g_restore_standard_registers(list: Taasmoutput); override;
+
+    procedure a_loadaddr_ref_reg(list: taasmoutput; const ref: treference; r:
+      tregister); override;
+
+    procedure g_concatcopy(list: taasmoutput; const source, dest: treference;
+      len: aint); override;
+
+    procedure g_overflowcheck(list: taasmoutput; const l: tlocation; def: tdef);
+      override;
+    procedure a_jmp_cond(list: taasmoutput; cond: TOpCmp; l: tasmlabel);
+
+    procedure g_intf_wrapper(list: TAAsmoutput; procdef: tprocdef; const
+      labelname: string; ioffset: longint); override;
+
+  private
+
+    { Make sure ref is a valid reference for the PowerPC and sets the }
+    { base to the value of the index if (base = R_NO).                }
+    { Returns true if the reference contained a base, index and an    }
+    { offset or symbol, in which case the base will have been changed }
+    { to a tempreg (which has to be freed by the caller) containing   }
+    { the sum of part of the original reference                       }
+    function fixref(list: taasmoutput; var ref: treference): boolean;
+
+    { returns whether a reference can be used immediately in a powerpc }
+    { instruction                                                      }
+    function issimpleref(const ref: treference): boolean;
+
+    { contains the common code of a_load_reg_ref and a_load_ref_reg }
+    procedure a_load_store(list: taasmoutput; op: tasmop; reg: tregister;
+      ref: treference);
+
+    { creates the correct branch instruction for a given combination }
+    { of asmcondflags and destination addressing mode                }
+    procedure a_jmp(list: taasmoutput; op: tasmop;
+      c: tasmcondflag; crval: longint; l: tasmlabel);
+  end;
+
+const
+  TOpCG2AsmOpConstLo: array[topcg] of TAsmOp = (A_NONE, A_ADDI, A_ANDI_,
+    A_DIVWU,
+    A_DIVW, A_MULLW, A_MULLW, A_NONE, A_NONE, A_ORI,
+    A_SRAWI, A_SLWI, A_SRWI, A_SUBI, A_XORI);
+  TOpCG2AsmOpConstHi: array[topcg] of TAsmOp = (A_NONE, A_ADDIS, A_ANDIS_,
+    A_DIVWU, A_DIVW, A_MULLW, A_MULLW, A_NONE, A_NONE,
+    A_ORIS, A_NONE, A_NONE, A_NONE, A_SUBIS, A_XORIS);
+
+  TShiftOpCG2AsmOpConst32 : array[OP_SAR..OP_SHR] of TAsmOp = (A_SRAWI, A_SLWI, A_SRWI);
+  TShiftOpCG2AsmOpConst64 : array[OP_SAR..OP_SHR] of TAsmOp = (A_SRADI, A_SLDI, A_SRDI);
+
+  TOpCmp2AsmCond: array[topcmp] of TAsmCondFlag = (C_NONE, C_EQ, C_GT,
+    C_LT, C_GE, C_LE, C_NE, C_LE, C_LT, C_GE, C_GT);
+
+implementation
+
+uses
+  sysutils,
+  globals, verbose, systems, cutils,
+  symconst, symsym, fmodule,
+  rgobj, tgobj, cpupi, procinfo, paramgr;
+
+procedure tcgppc.init_register_allocators;
+begin
+  inherited init_register_allocators;
+  rg[R_INTREGISTER] := trgcpu.create(R_INTREGISTER, R_SUBWHOLE,
+    [RS_R3, RS_R4, RS_R5, RS_R6, RS_R7, RS_R8,
+      RS_R9, RS_R10, RS_R11, RS_R12, RS_R31, RS_R30, RS_R29,
+      RS_R28, RS_R27, RS_R26, RS_R25, RS_R24, RS_R23, RS_R22,
+      RS_R21, RS_R20, RS_R19, RS_R18, RS_R17, RS_R16, RS_R15,
+      RS_R14, RS_R13], first_int_imreg, []);
+  rg[R_FPUREGISTER] := trgcpu.create(R_FPUREGISTER, R_SUBNONE,
+    [RS_F0, RS_F1, RS_F2, RS_F3, RS_F4, RS_F5, RS_F6, RS_F7, RS_F8, RS_F9,
+    RS_F10, RS_F11, RS_F12, RS_F13, RS_F31, RS_F30, RS_F29, RS_F28, RS_F27,
+      RS_F26, RS_F25, RS_F24, RS_F23, RS_F22, RS_F21, RS_F20, RS_F19, RS_F18,
+      RS_F17, RS_F16, RS_F15, RS_F14], first_fpu_imreg, []);
+{$WARNING FIX ME}
+  rg[R_MMREGISTER] := trgcpu.create(R_MMREGISTER, R_SUBNONE,
+    [RS_M0, RS_M1, RS_M2], first_mm_imreg, []);
+end;
+
+procedure tcgppc.done_register_allocators;
+begin
+  rg[R_INTREGISTER].free;
+  rg[R_FPUREGISTER].free;
+  rg[R_MMREGISTER].free;
+  inherited done_register_allocators;
+end;
+
+procedure tcgppc.a_param_const(list: taasmoutput; size: tcgsize; a: aint; const
+  paraloc: tcgpara);
+var
+  ref: treference;
+begin
+  paraloc.check_simple_location;
+  case paraloc.location^.loc of
+    LOC_REGISTER, LOC_CREGISTER:
+      a_load_const_reg(list, size, a, paraloc.location^.register);
+    LOC_REFERENCE:
+      begin
+        reference_reset(ref);
+        ref.base := paraloc.location^.reference.index;
+        ref.offset := paraloc.location^.reference.offset;
+        a_load_const_ref(list, size, a, ref);
+      end;
+  else
+    internalerror(2002081101);
+  end;
+end;
+
+procedure tcgppc.a_param_ref(list: taasmoutput; size: tcgsize; const r:
+  treference; const paraloc: tcgpara);
+
+var
+  tmpref, ref: treference;
+  location: pcgparalocation;
+  sizeleft: aint;
+
+begin
+  location := paraloc.location;
+  tmpref := r;
+  sizeleft := paraloc.intsize;
+  while assigned(location) do
+  begin
+    case location^.loc of
+      LOC_REGISTER, LOC_CREGISTER:
+        begin
+          a_load_ref_reg(list, location^.size, location^.size, tmpref,
+            location^.register);
+        end;
+      LOC_REFERENCE:
+        begin
+          reference_reset_base(ref, location^.reference.index,
+            location^.reference.offset);
+          g_concatcopy(list, tmpref, ref, sizeleft);
+          if assigned(location^.next) then
+            internalerror(2005010710);
+        end;
+      LOC_FPUREGISTER, LOC_CFPUREGISTER:
+        case location^.size of
+          OS_F32, OS_F64:
+            a_loadfpu_ref_reg(list, location^.size, tmpref, location^.register);
+        else
+          internalerror(2002072801);
+        end;
+      LOC_VOID:
+        begin
+          // nothing to do
+        end;
+    else
+      internalerror(2002081103);
+    end;
+    inc(tmpref.offset, tcgsize2size[location^.size]);
+    dec(sizeleft, tcgsize2size[location^.size]);
+    location := location^.next;
+  end;
+end;
+
+procedure tcgppc.a_paramaddr_ref(list: taasmoutput; const r: treference; const
+  paraloc: tcgpara);
+var
+  ref: treference;
+  tmpreg: tregister;
+
+begin
+  paraloc.check_simple_location;
+  case paraloc.location^.loc of
+    LOC_REGISTER, LOC_CREGISTER:
+      a_loadaddr_ref_reg(list, r, paraloc.location^.register);
+    LOC_REFERENCE:
+      begin
+        reference_reset(ref);
+        ref.base := paraloc.location^.reference.index;
+        ref.offset := paraloc.location^.reference.offset;
+        tmpreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
+        a_loadaddr_ref_reg(list, r, tmpreg);
+        a_load_reg_ref(list, OS_ADDR, OS_ADDR, tmpreg, ref);
+      end;
+  else
+    internalerror(2002080701);
+  end;
+end;
+
+{ calling a procedure by name }
+
+procedure tcgppc.a_call_name(list: taasmoutput; const s: string);
+begin
+        a_call_name_direct(list, s, true);
+end;
+
+procedure tcgppc.a_call_name_direct(list: taasmoutput; s: string; prependDot : boolean);
+begin
+  if (prependDot) then begin
+        s := '.' + s;
+  end;
+  list.concat(taicpu.op_sym(A_BL, objectlibrary.newasmsymbol(s, AB_EXTERNAL,
+    AT_FUNCTION)));
+  list.concat(taicpu.op_none(A_NOP));
+  {
+         the compiler does not properly set this flag anymore in pass 1, and
+         for now we only need it after pass 2 (I hope) (JM)
+           if not(pi_do_call in current_procinfo.flags) then
+             internalerror(2003060703);
+  }
+  include(current_procinfo.flags, pi_do_call);
+end;
+
+
+{ calling a procedure by address }
+
+procedure tcgppc.a_call_reg(list: taasmoutput; reg: tregister);
+
+var
+  tmpreg: tregister;
+  tmpref: treference;
+
+  gotref : treference;
+
+begin
+  tmpreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
+
+  reference_reset(tmpref);
+  tmpref.offset := 0;
+  tmpref.base := reg;
+  list.concat(taicpu.op_reg_ref(A_LD, tmpreg, tmpref));
+
+//  TODO: GOT change
+
+//  reference_reset(gotref);
+//  tmpref.offset := 40;
+//  tmpref.base := rg[R_INTREGISTER].getregister(list, NR_STACK_POINTER_REG);
+
+//  taicpu.op_load_reg_ref(list, OS_INT, OS_INT,
+  list.concat(taicpu.op_reg(A_MTCTR, tmpreg));
+
+
+  list.concat(taicpu.op_none(A_BCTRL));
+  //if target_info.system=system_powerpc_macos then
+  //  //NOP is not needed here.
+  //  list.concat(taicpu.op_none(A_NOP));
+  include(current_procinfo.flags, pi_do_call);
+end;
+
+{********************** load instructions ********************}
+
+procedure tcgppc.a_load_const_reg(list: taasmoutput; size: TCGSize; a: aint;
+  reg: TRegister);
+
+var
+  scratchreg : TRegister;
+
+  procedure load32bitconstant(list : taasmoutput; size : TCGSize; a : longint;
+    reg : TRegister);
+  var is_half_signed : boolean;
+  begin
+(*
+    // ts: test optimized code using LI/ADDIS
+
+    if (smallint(a) = 0) and ((a shr 16) <> 0) then begin
+      list.concat(taicpu.op_reg_const(A_LIS, reg, smallint(a shr 16)));
+    end else begin
+      is_half_signed := smallint(a) < 0;
+      list.concat(taicpu.op_reg_const(A_LI, reg, smallint(a)));
+      if smallint((a shr 16) + ord(is_half_signed)) <> 0 then begin
+        list.concat(taicpu.op_reg_reg_const(A_ADDIS, reg, reg, smallint((a shr 16) + ord(is_half_signed))));
+      end;
+    end;
+*)
+    // only 16 bit constant? (-2^15 <= a <= +2^15-1)
+    if (a >= low(smallint)) and (a <= high(smallint)) then begin
+      list.concat(taicpu.op_reg_const(A_LI, reg, smallint(a)));
+    end else begin
+      { check if we have to start with LI or LIS, load as 32 bit constant }
+      if ((a and $FFFF) <> 0) then begin
+        list.concat(taicpu.op_reg_const(A_LIS, reg, smallint(a shr 16)));
+        list.concat(taicpu.op_reg_reg_const(A_ORI, reg, reg, word(a)));
+
+      end else begin
+        list.concat(taicpu.op_reg_const(A_LIS, reg, smallint(a shr 16)));
+      end;
+    end;
+
+  end;
+var
+  astring : string;
+
+begin
+  astring := 'a_load_const reg ' + inttostr(a) + ' ' + inttostr(tcgsize2size[size]);
+  list.concat(tai_comment.create(strpnew(astring)));
+  if not (size in [OS_8, OS_S8, OS_16, OS_S16, OS_32, OS_S32, OS_64, OS_S64]) then
+    internalerror(2002090902);
+  // load low 32 bit (as signed number)
+  load32bitconstant(list, size, lo(a), reg);
+
+  // load high 32 bit if needed :( (the second expression is optimization, to be enabled and tested later!)
+  if (size in [OS_64, OS_S64]) {and (hi(a) <> 0)} then begin
+    // allocate scratch reg (=R0 because it might be called at places where register
+    // allocation has already happened - either procedure entry/exit, and stack check
+    // code generation)
+    // Note: I hope this restriction can be lifted at some time
+
+    //scratchreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
+    // load high 32 bit
+    load32bitconstant(list, size, hi(a), NR_R0);
+    // combine both registers
+    list.concat(taicpu.op_reg_reg_const_const(A_RLDIMI, reg, NR_R0, 32, 0));
+  end;
+(*
+  // for 16/32 bit unsigned constants we need to make sure that the difference from this size to
+  // 32 bits is cleared (since we optimize loading them as signed 16 bit parts, but 32 bit ops are
+  // used for them.
+  // e.g. for 16 bit there's a problem if the (unsigned) constant is of the form
+  //   xx..xx xx..xx 00..00 1x..xx
+  // same problem as above for 32 bit: unsigned constants of the form
+  //   xx..xx xx..xx 00..00 1x..xx
+  // cause troubles. Signed are ok.
+  // for now, just clear the upper 48/32 bits (also because full 32 bit op usage isn't done yet)
+  if (size in [OS_16, OS_32]) {and (lo(a) < 0)} then begin
+    a_load_reg_reg(list, size, size, reg, reg);
+  end; *)
+  // need to clear MSB for unsigned 64 bit int because we did not load the upper
+  // 32 bit at all (second expression is optimization: enable and test later!)
+  // e.g. constants of the form 00..00 00..00 1x..xx xx..xx
+  if (size in [OS_64]) and (hi(a) = 0) then begin
+        list.concat(taicpu.op_reg_reg_const_const(A_RLDICL, reg, reg, 0, 32));
+  end;
+end;
+
+procedure tcgppc.a_load_reg_ref(list: taasmoutput; fromsize, tosize: TCGSize;
+  reg: tregister; const ref: treference);
+
+const
+  StoreInstr: array[OS_8..OS_64, boolean, boolean] of TAsmOp =
+  { indexed? updating?}
+  (((A_STB, A_STBU), (A_STBX, A_STBUX)),
+    ((A_STH, A_STHU), (A_STHX, A_STHUX)),
+    ((A_STW, A_STWU), (A_STWX, A_STWUX)),
+    ((A_STD, A_STDU), (A_STDX, A_STDUX))
+    );
+var
+  op: TAsmOp;
+  ref2: TReference;
+begin
+  ref2 := ref;
+  fixref(list, ref2);
+  if tosize in [OS_S8..OS_S64] then
+    { storing is the same for signed and unsigned values }
+    tosize := tcgsize(ord(tosize) - (ord(OS_S8) - ord(OS_8)));
+  op := storeinstr[tcgsize2unsigned[tosize], ref2.index <> NR_NO, false];
+  a_load_store(list, op, reg, ref2);
+end;
+
+procedure tcgppc.a_load_ref_reg(list: taasmoutput; fromsize, tosize: tcgsize;
+  const ref: treference; reg: tregister);
+
+const
+  LoadInstr: array[OS_8..OS_S64, boolean, boolean] of TAsmOp =
+  { indexed? updating?}
+  (((A_LBZ, A_LBZU), (A_LBZX, A_LBZUX)),
+    ((A_LHZ, A_LHZU), (A_LHZX, A_LHZUX)),
+    ((A_LWZ, A_LWZU), (A_LWZX, A_LWZUX)),
+    ((A_LD, A_LDU), (A_LDX, A_LDUX)),
+    { 128bit stuff too }
+    ((A_NONE, A_NONE), (A_NONE, A_NONE)),
+    { there's no load-byte-with-sign-extend :( }
+    ((A_LBZ, A_LBZU), (A_LBZX, A_LBZUX)),
+    ((A_LHA, A_LHAU), (A_LHAX, A_LHAUX)),
+    { there's no load-word-arithmetic-indexed with update, simulate it in code :( }
+    ((A_LWA, A_LWAU), (A_LWAX, A_LWAUX)),
+    ((A_LD, A_LDU), (A_LDX, A_LDUX))
+    );
+var
+  op: tasmop;
+  ref2: treference;
+
+begin
+  { TODO: optimize/take into consideration fromsize/tosize. Will }
+  { probably only matter for OS_S8 loads though                  }
+  if not (fromsize in [OS_8, OS_S8, OS_16, OS_S16, OS_32, OS_S32, OS_64, OS_S64]) then
+    internalerror(2002090902);
+  ref2 := ref;
+  fixref(list, ref2);
+  { the caller is expected to have adjusted the reference already }
+  { in this case                                                  }
+  if (TCGSize2Size[fromsize] >= TCGSize2Size[tosize]) then
+    fromsize := tosize;
+  op := loadinstr[fromsize, ref2.index <> NR_NO, false];
+  // there is no LWAU instruction, simulate using ADDI and LWA
+  if (op = A_LWAU) then begin
+        list.concat(taicpu.op_reg_reg_const(A_ADDI, reg, reg, ref2.offset));
+        ref2.offset := 0;
+        op := A_LWA;
+  end;
+  a_load_store(list, op, reg, ref2);
+  // sign extend shortint if necessary, since there is no
+  // load instruction that does that automatically (JM)
+  if fromsize = OS_S8 then
+    list.concat(taicpu.op_reg_reg(A_EXTSB, reg, reg));
+end;
+
+procedure tcgppc.a_load_reg_reg(list: taasmoutput; fromsize, tosize: tcgsize;
+  reg1, reg2: tregister);
+
+const
+  movemap : array[OS_8..OS_S128, OS_8..OS_S128] of tasmop = (
+{     to  -> OS_8      OS_16     OS_32     OS_64     OS_128    OS_S8     OS_S16    OS_S32    OS_S64    OS_S128 }
+{ from }
+{ OS_8    } (A_MR,     A_RLDICL, A_RLDICL, A_RLDICL, A_NONE,   A_RLDICL, A_RLDICL, A_RLDICL, A_RLDICL, A_NOP   ),
+{ OS_16   } (A_RLDICL, A_MR,     A_RLDICL, A_RLDICL, A_NONE,   A_RLDICL, A_RLDICL, A_RLDICL, A_RLDICL, A_NOP   ),
+{ OS_32   } (A_RLDICL, A_RLDICL, A_MR,     A_RLDICL, A_NONE,   A_RLDICL, A_RLDICL, A_RLDICL, A_RLDICL, A_NOP   ),
+{ OS_64   } (A_RLDICL, A_RLDICL, A_RLDICL, A_MR,     A_NONE,   A_RLDICL, A_RLDICL, A_RLDICL, A_RLDICL, A_NOP   ),
+{ OS_128  } (A_NONE,   A_NONE,   A_NONE,   A_NONE,   A_NONE,   A_NONE,   A_NONE,   A_NONE,   A_NONE,   A_NOP   ),
+{ OS_S8   } (A_EXTSB,  A_EXTSB,  A_EXTSB,  A_EXTSB,  A_NONE,   A_MR,     A_EXTSB,  A_EXTSB,  A_EXTSB,  A_NOP   ),
+{ OS_S16  } (A_RLDICL, A_EXTSH,  A_EXTSH,  A_EXTSH,  A_NONE,   A_EXTSB,  A_MR,     A_EXTSH,  A_EXTSH,  A_NOP   ),
+{ OS_S32  } (A_RLDICL, A_RLDICL, A_EXTSW,  A_EXTSW,  A_NONE,   A_EXTSB,  A_EXTSH,  A_MR,     A_EXTSW,  A_NOP   ),
+{ OS_S64  } (A_RLDICL, A_RLDICL, A_RLDICL, A_MR,     A_NONE,   A_EXTSB,  A_EXTSH,  A_EXTSW,  A_MR,     A_NOP   ),
+{ OS_S128 } (A_NONE,   A_NONE,   A_NONE,   A_NONE,   A_NONE,   A_NONE,   A_NONE,   A_NONE,   A_NONE,   A_NOP   )
+);
+
+var
+  instr: taicpu;
+  op : tasmop;
+begin
+  op := movemap[fromsize, tosize];
+  case op of
+        A_MR, A_EXTSB, A_EXTSH, A_EXTSW : instr := taicpu.op_reg_reg(op, reg2, reg1);
+        A_RLDICL : instr := taicpu.op_reg_reg_const_const(A_RLDICL, reg2, reg1, 0, (8-tcgsize2size[fromsize])*8);
+  else
+    internalerror(2002090901);
+  end;
+  list.concat(instr);
+  rg[R_INTREGISTER].add_move_instruction(instr);
+end;
+
+procedure tcgppc.a_loadfpu_reg_reg(list: taasmoutput; size: tcgsize; reg1, reg2:
+  tregister);
+var
+  instr: taicpu;
+begin
+  instr := taicpu.op_reg_reg(A_FMR, reg2, reg1);
+  list.concat(instr);
+  rg[R_FPUREGISTER].add_move_instruction(instr);
+end;
+
+procedure tcgppc.a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref:
+  treference; reg: tregister);
+const
+  FpuLoadInstr: array[OS_F32..OS_F64, boolean, boolean] of TAsmOp =
+  { indexed? updating?}
+  (((A_LFS, A_LFSU), (A_LFSX, A_LFSUX)),
+   ((A_LFD, A_LFDU), (A_LFDX, A_LFDUX)));
+var
+  op: tasmop;
+  ref2: treference;
+
+begin
+  { several functions call this procedure with OS_32 or OS_64 }
+  { so this makes life easier (FK)                            }
+  case size of
+    OS_32, OS_F32:
+      size := OS_F32;
+    OS_64, OS_F64, OS_C64:
+      size := OS_F64;
+  else
+    internalerror(200201121);
+  end;
+  ref2 := ref;
+  fixref(list, ref2);
+  op := fpuloadinstr[size, ref2.index <> NR_NO, false];
+  a_load_store(list, op, reg, ref2);
+end;
+
+procedure tcgppc.a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg:
+  tregister; const ref: treference);
+
+const
+  FpuStoreInstr: array[OS_F32..OS_F64, boolean, boolean] of TAsmOp =
+  { indexed? updating?}
+  (((A_STFS, A_STFSU), (A_STFSX, A_STFSUX)),
+   ((A_STFD, A_STFDU), (A_STFDX, A_STFDUX)));
+var
+  op: tasmop;
+  ref2: treference;
+
+begin
+  if not (size in [OS_F32, OS_F64]) then
+    internalerror(200201122);
+  ref2 := ref;
+  fixref(list, ref2);
+  op := fpustoreinstr[size, ref2.index <> NR_NO, false];
+  a_load_store(list, op, reg, ref2);
+end;
+
+procedure tcgppc.a_op_const_reg(list: taasmoutput; Op: TOpCG; size: TCGSize; a:
+  aint; reg: TRegister);
+begin
+  a_op_const_reg_reg(list, op, size, a, reg, reg);
+end;
+
+procedure tcgppc.a_op_reg_reg(list: taasmoutput; Op: TOpCG; size: TCGSize; src,
+  dst: TRegister);
+begin
+  a_op_reg_reg_reg(list, op, size, src, dst, dst);
+end;
+
+procedure tcgppc.a_op_const_reg_reg(list: taasmoutput; op: TOpCg;
+  size: tcgsize; a: aint; src, dst: tregister);
+var
+  l1, l2: longint;
+  oplo, ophi: tasmop;
+  scratchreg: tregister;
+  useReg : boolean;
+  shiftmask : longint;
+
+  procedure do_lo_hi;
+  begin
+    usereg := false;
+    if (size in [OS_64, OS_S64]) then begin
+      // ts: use register method for 64 bit consts. Sloooooow
+      usereg := true;
+    end else if (size in [OS_32, OS_S32]) then begin
+      list.concat(taicpu.op_reg_reg_const(oplo, dst, src, word(a)));
+      list.concat(taicpu.op_reg_reg_const(ophi, dst, dst, word(a shr 16)));
+    end else begin
+      list.concat(taicpu.op_reg_reg_const(oplo, dst, src, word(a)));
+    end;
+  end;
+
+begin
+  if op = OP_SUB then begin
+    a_op_const_reg_reg(list, OP_ADD, size, -a, src, dst);
+    exit;
+  end;
+  ophi := TOpCG2AsmOpConstHi[op];
+  oplo := TOpCG2AsmOpConstLo[op];
+  // peephole optimizations for AND, OR, XOR - can't this be done at
+  // some higher level, independent of architecture?
+  if (op in [OP_AND, OP_OR, OP_XOR]) then begin
+    if (a = 0) then begin
+      if op = OP_AND then
+        list.concat(taicpu.op_reg_const(A_LI, dst, 0))
+      else
+        a_load_reg_reg(list, size, size, src, dst);
+      exit;
+    end else if (a = -1) then begin
+      case op of
+        OP_OR:
+          list.concat(taicpu.op_reg_const(A_LI, dst, -1));
+        OP_XOR:
+          list.concat(taicpu.op_reg_reg(A_NOT, dst, src));
+        OP_AND:
+          a_load_reg_reg(list, size, size, src, dst);
+      end;
+      exit;
+    end;
+  { optimization for add }
+  end else if (op = OP_ADD) then
+    if a = 0 then begin
+      a_load_reg_reg(list, size, size, src, dst);
+      exit;
+    end else if (a >= low(smallint)) and (a <= high(smallint)) then begin
+      list.concat(taicpu.op_reg_reg_const(A_ADDI, dst, src, smallint(a)));
+      exit;
+    end;
+
+  { otherwise, the instructions we can generate depend on the }
+  { operation                                                 }
+  useReg := false;
+  case op of
+    OP_DIV, OP_IDIV:
+      if (a = 0) then
+        internalerror(200208103)
+      else if (a = 1) then begin
+        a_load_reg_reg(list, OS_INT, OS_INT, src, dst);
+        exit
+      end else if false {and ispowerof2(a, l1)} then begin
+        internalerror(200208103);
+        case op of
+          OP_DIV: begin
+            list.concat(taicpu.op_reg_reg_const(A_SRDI, dst, src, l1));
+          end;
+          OP_IDIV:
+            begin
+              list.concat(taicpu.op_reg_reg_const(A_SRADI, dst, src, l1));
+              list.concat(taicpu.op_reg_reg(A_ADDZE, dst, dst));
+            end;
+        end;
+        exit;
+      end else
+        usereg := true;
+    OP_IMUL, OP_MUL:
+      if (a = 0) then begin
+        list.concat(taicpu.op_reg_const(A_LI, dst, 0));
+        exit
+      end else if (a = -1) then begin
+        list.concat(taicpu.op_reg_reg(A_NEG, dst, dst));
+      end else if (a = 1) then begin
+        a_load_reg_reg(list, OS_INT, OS_INT, src, dst);
+        exit
+      end else if ispowerof2(a, l1) then
+        list.concat(taicpu.op_reg_reg_const(A_SLDI, dst, src, l1))
+      else if (a >= low(smallint)) and (a <= high(smallint)) then
+        list.concat(taicpu.op_reg_reg_const(A_MULLI, dst, src,
+          smallint(a)))
+      else
+        usereg := true;
+    OP_ADD:
+      {$todo ts:optimize}
+      useReg := true;
+    OP_OR:
+      do_lo_hi;
+    OP_AND:
+      useReg := true;
+    OP_XOR:
+      do_lo_hi;
+    OP_SHL, OP_SHR, OP_SAR:
+      begin
+        {$note ts: cleanup todo, fix remaining bugs}
+        if (size in [OS_64, OS_S64]) then begin
+          if (a and 63) <> 0 then
+            list.concat(taicpu.op_reg_reg_const(
+              TShiftOpCG2AsmOpConst64[Op], dst, src, a and 63))
+          else
+            a_load_reg_reg(list, size, size, src, dst);
+          if (a shr 6) <> 0 then
+            internalError(68991);
+        end else begin
+          if (a and 31) <> 0 then
+            list.concat(taicpu.op_reg_reg_const(
+              TShiftOpCG2AsmOpConst32[Op], dst, src, a and 31))
+          else
+            a_load_reg_reg(list, size, size, src, dst);
+          if (a shr 5) <> 0 then
+            internalError(68991);
+        end;
+      end
+  else
+    internalerror(200109091);
+  end;
+  { if all else failed, load the constant in a register and then }
+  { perform the operation                                        }
+  if useReg then begin
+    scratchreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
+    a_load_const_reg(list, size, a, scratchreg);
+    a_op_reg_reg_reg(list, op, size, scratchreg, src, dst);
+  end;
+end;
+
+procedure tcgppc.a_op_reg_reg_reg(list: taasmoutput; op: TOpCg;
+  size: tcgsize; src1, src2, dst: tregister);
+
+const
+  op_reg_reg_opcg2asmop32: array[TOpCG] of tasmop =
+  (A_NONE, A_ADD, A_AND, A_DIVWU, A_DIVW, A_MULLW, A_MULLW, A_NEG, A_NOT, A_OR,
+   A_SRAW, A_SLW, A_SRW, A_SUB, A_XOR);
+  op_reg_reg_opcg2asmop64: array[TOpCG] of tasmop =
+  (A_NONE, A_ADD, A_AND, A_DIVDU, A_DIVD, A_MULLD, A_MULLD, A_NEG, A_NOT, A_OR,
+   A_SRAD, A_SLD, A_SRD, A_SUB, A_XOR);
+
+begin
+  case op of
+    OP_NEG, OP_NOT:
+      begin
+        list.concat(taicpu.op_reg_reg(op_reg_reg_opcg2asmop64[op], dst, src1));
+        if (op = OP_NOT) and
+          not (size in [OS_64, OS_S64]) then
+          { zero/sign extend result again, fromsize is not important here }
+          a_load_reg_reg(list, OS_S64, size, dst, dst)
+      end;
+  else
+  {$NOTE ts:testme}
+    if (size in [OS_64, OS_S64]) then begin
+      list.concat(taicpu.op_reg_reg_reg(op_reg_reg_opcg2asmop64[op], dst, src2,
+        src1));
+    end else begin
+      list.concat(taicpu.op_reg_reg_reg(op_reg_reg_opcg2asmop32[op], dst, src2,
+        src1));
+    end;
+  end;
+end;
+
+{*************** compare instructructions ****************}
+
+procedure tcgppc.a_cmp_const_reg_label(list: taasmoutput; size: tcgsize; cmp_op:
+  topcmp; a: aint; reg: tregister;
+  l: tasmlabel);
+
+var
+  scratch_register: TRegister;
+  signed: boolean;
+
+begin
+  signed := cmp_op in [OC_GT, OC_LT, OC_GTE, OC_LTE];
+  { in the following case, we generate more efficient code when }
+  { signed is true                                              }
+  if (cmp_op in [OC_EQ, OC_NE]) and
+    (aword(a) > $FFFF) then
+    signed := true;
+  if signed then
+    if (a >= low(smallint)) and (a <= high(smallint)) then
+      list.concat(taicpu.op_reg_reg_const(A_CMPDI, NR_CR0, reg, a))
+    else
+    begin
+      scratch_register := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
+      a_load_const_reg(list, OS_64, a, scratch_register);
+      list.concat(taicpu.op_reg_reg_reg(A_CMPD, NR_CR0, reg, scratch_register));
+    end
+  else if (aword(a) <= $FFFF) then
+    list.concat(taicpu.op_reg_reg_const(A_CMPLDI, NR_CR0, reg, aword(a)))
+  else
+  begin
+    scratch_register := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
+    a_load_const_reg(list, OS_64, a, scratch_register);
+    list.concat(taicpu.op_reg_reg_reg(A_CMPLD, NR_CR0, reg,
+      scratch_register));
+  end;
+  a_jmp(list, A_BC, TOpCmp2AsmCond[cmp_op], 0, l);
+end;
+
+procedure tcgppc.a_cmp_reg_reg_label(list: taasmoutput; size: tcgsize; cmp_op:
+  topcmp;
+  reg1, reg2: tregister; l: tasmlabel);
+
+var
+  op: tasmop;
+
+begin
+  if cmp_op in [OC_GT, OC_LT, OC_GTE, OC_LTE] then
+    if (size in [OS_64, OS_S64]) then
+      op := A_CMPD
+    else
+      op := A_CMPW
+  else
+    if (size in [OS_64, OS_S64]) then
+      op := A_CMPLD
+    else
+      op := A_CMPLW;
+  list.concat(taicpu.op_reg_reg_reg(op, NR_CR0, reg2, reg1));
+  a_jmp(list, A_BC, TOpCmp2AsmCond[cmp_op], 0, l);
+end;
+
+procedure tcgppc.a_jmp_cond(list: taasmoutput; cond: TOpCmp; l: tasmlabel);
+
+begin
+  a_jmp(list, A_BC, TOpCmp2AsmCond[cond], 0, l);
+end;
+
+procedure tcgppc.a_jmp_name(list: taasmoutput; const s: string);
+var
+  p: taicpu;
+begin
+  p := taicpu.op_sym(A_B, objectlibrary.newasmsymbol(s, AB_EXTERNAL,
+    AT_LABEL));
+  p.is_jmp := true;
+  list.concat(p)
+end;
+
+procedure tcgppc.a_jmp_always(list: taasmoutput; l: tasmlabel);
+
+begin
+  a_jmp(list, A_B, C_None, 0, l);
+end;
+
+procedure tcgppc.a_jmp_flags(list: taasmoutput; const f: TResFlags; l:
+  tasmlabel);
+
+var
+  c: tasmcond;
+begin
+  c := flags_to_cond(f);
+  a_jmp(list, A_BC, c.cond, c.cr - RS_CR0, l);
+end;
+
+procedure tcgppc.g_flags2reg(list: taasmoutput; size: TCgSize; const f:
+  TResFlags; reg: TRegister);
+
+var
+  testbit: byte;
+  bitvalue: boolean;
+
+begin
+  { get the bit to extract from the conditional register + its }
+  { requested value (0 or 1)                                   }
+  testbit := ((f.cr - RS_CR0) * 4);
+  case f.flag of
+    F_EQ, F_NE:
+      begin
+        inc(testbit, 2);
+        bitvalue := f.flag = F_EQ;
+      end;
+    F_LT, F_GE:
+      begin
+        bitvalue := f.flag = F_LT;
+      end;
+    F_GT, F_LE:
+      begin
+        inc(testbit);
+        bitvalue := f.flag = F_GT;
+      end;
+  else
+    internalerror(200112261);
+  end;
+  { load the conditional register in the destination reg }
+  list.concat(taicpu.op_reg(A_MFCR, reg));
+  { we will move the bit that has to be tested to bit 0 by rotating }
+  { left                                                            }
+  testbit := (testbit + 1) and 31;
+  { extract bit }
+  list.concat(taicpu.op_reg_reg_const_const_const(
+    A_RLWINM,reg,reg,testbit,31,31));
+
+  { if we need the inverse, xor with 1 }
+  if not bitvalue then
+    list.concat(taicpu.op_reg_reg_const(A_XORI, reg, reg, 1));
+end;
+
+{ *********** entry/exit code and address loading ************ }
+
+procedure tcgppc.g_save_standard_registers(list: Taasmoutput);
+begin
+  { this work is done in g_proc_entry }
+end;
+
+procedure tcgppc.g_restore_standard_registers(list: Taasmoutput);
+begin
+  { this work is done in g_proc_exit }
+end;
+
+procedure tcgppc.g_proc_entry(list: taasmoutput; localsize: longint;
+  nostackframe: boolean);
+{ generated the entry code of a procedure/function. Note: localsize is the }
+{ sum of the size necessary for local variables and the maximum possible   }
+{ combined size of ALL the parameters of a procedure called by the current }
+{ one.                                                                     }
+{ This procedure may be called before, as well as after g_return_from_proc }
+{ is called. NOTE registers are not to be allocated through the register   }
+{ allocator here, because the register colouring has already occured !!    }
+  procedure calcFirstUsedFPR(out firstfpr : TSuperRegister; out fprcount : aint);
+  var
+    reg : TSuperRegister;
+  begin
+    fprcount := 0;
+    firstfpr := RS_F31;
+    if not (po_assembler in current_procinfo.procdef.procoptions) then begin
+      for reg := RS_F14 to RS_F31 do begin
+        if reg in rg[R_FPUREGISTER].used_in_proc then begin
+          fprcount := ord(RS_F31)-ord(reg)+1;
+          firstfpr := reg;
+          break;
+        end;
+      end;
+    end;
+  end;
+
+  procedure calcFirstUsedGPR(out firstgpr : TSuperRegister; out gprcount : aint);
+  var
+    reg : TSuperRegister;
+  begin
+    gprcount := 0;
+    firstgpr := RS_R31;
+    if not (po_assembler in current_procinfo.procdef.procoptions) then begin
+      for reg := RS_R14 to RS_R31 do begin
+        if reg in rg[R_INTREGISTER].used_in_proc then begin
+          gprcount := ord(RS_R31)-ord(reg)+1;
+          firstgpr := reg;
+          break;
+        end;
+      end;
+    end;
+  end;
+
+var
+  firstregfpu, firstreggpr: TSuperRegister;
+  href: treference;
+  needslinkreg: boolean;
+  regcount : TSuperRegister;
+
+  fprcount, gprcount : aint;
+
+begin
+  { CR and LR only have to be saved in case they are modified by the current }
+  { procedure, but currently this isn't checked, so save them always         }
+  { following is the entry code as described in "Altivec Programming }
+  { Interface Manual", bar the saving of AltiVec registers           }
+  a_reg_alloc(list, NR_STACK_POINTER_REG);
+  a_reg_alloc(list, NR_R0);
+
+  calcFirstUsedFPR(firstregfpu, fprcount);
+  calcFirstUsedGPR(firstreggpr, gprcount);
+
+  // calculate real stack frame size
+  localsize := tppcprocinfo(current_procinfo).calc_stackframe_size(
+    gprcount, fprcount);
+
+  // determine whether we need to save the link register
+  needslinkreg := ((not (po_assembler in current_procinfo.procdef.procoptions)) and
+    (pi_do_call in current_procinfo.flags));
+
+  // move link register to r0
+  if (needslinkreg) then begin
+    list.concat(taicpu.op_reg(A_MFLR, NR_R0));
+  end;
+  // save old stack frame pointer
+  if (localsize > 0) then begin
+    a_reg_alloc(list, NR_R12);
+    list.concat(taicpu.op_reg_reg(A_MR, NR_R12, NR_STACK_POINTER_REG));
+  end;
+
+  // save registers, FPU first, then GPR
+  reference_reset_base(href, NR_STACK_POINTER_REG, -8);
+  if (fprcount > 0) then begin
+    for regcount := RS_F31 downto firstregfpu do begin
+      a_loadfpu_reg_ref(list, OS_FLOAT, newreg(R_FPUREGISTER, regcount,
+        R_SUBNONE), href);
+      dec(href.offset, tcgsize2size[OS_FLOAT]);
+    end;
+  end;
+  if (gprcount > 0) then begin
+    for regcount := RS_R31 downto firstreggpr do begin
+      a_load_reg_ref(list, OS_INT, OS_INT, newreg(R_INTREGISTER, regcount,
+        R_SUBNONE), href);
+      dec(href.offset, tcgsize2size[OS_INT]);
+    end;
+  end;
+
+  // VMX registers not supported by FPC atm
+
+  // we may need to store R0 (=LR) ourselves
+  if (needslinkreg) then begin
+    reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_ELF);
+    list.concat(taicpu.op_reg_ref(A_STD, NR_R0, href));
+  end;
+
+  // create stack frame
+  if (not nostackframe) and (localsize > 0) then begin
+    if (localsize <= high(smallint)) then begin
+      reference_reset_base(href, NR_STACK_POINTER_REG, -localsize);
+      a_load_store(list, A_STDU, NR_STACK_POINTER_REG, href);
+    end else begin
+      reference_reset_base(href, NR_NO, -localsize);
+
+      // use R0 for loading the constant (which is definitely > 32k when entering
+      // this branch)
+      // inlined because it must not use temp registers because register allocations
+      // have already been done :(
+      { Code template:
+      lis   r0,ofs@highest
+      ori   r0,r0,ofs@higher
+      sldi  r0,r0,32
+      oris  r0,r0,ofs@h
+      ori   r0,r0,ofs@l
+      }
+      list.concat(taicpu.op_reg_const(A_LIS, NR_R0, word(href.offset shr 48)));
+      list.concat(taicpu.op_reg_reg_const(A_ORI, NR_R0, NR_R0, word(href.offset shr 32)));
+      list.concat(taicpu.op_reg_reg_const(A_SLDI, NR_R0, NR_R0, 32));
+      list.concat(taicpu.op_reg_reg_const(A_ORIS, NR_R0, NR_R0, word(href.offset shr 16)));
+      list.concat(taicpu.op_reg_reg_const(A_ORI, NR_R0, NR_R0, word(href.offset)));
+
+      list.concat(taicpu.op_reg_reg_reg(A_STDUX, NR_R1, NR_R1, NR_R0));
+    end;
+  end;
+
+  // CR register not used by FPC atm
+
+  // keep R1 allocated???
+  a_reg_dealloc(list, NR_R0);
+end;
+
+procedure tcgppc.g_proc_exit(list: taasmoutput; parasize: longint; nostackframe:
+  boolean);
+
+  procedure calcFirstUsedFPR(out firstfpr : TSuperRegister; out fprcount : aint);
+  var
+    reg : TSuperRegister;
+  begin
+    fprcount := 0;
+    firstfpr := RS_F31;
+    if not (po_assembler in current_procinfo.procdef.procoptions) then begin
+      for reg := RS_F14 to RS_F31 do begin
+        if reg in rg[R_FPUREGISTER].used_in_proc then begin
+          fprcount := ord(RS_F31)-ord(reg)+1;
+          firstfpr := reg;
+          break;
+        end;
+      end;
+    end;
+  end;
+
+  procedure calcFirstUsedGPR(out firstgpr : TSuperRegister; out gprcount : aint);
+  var
+    reg : TSuperRegister;
+  begin
+    gprcount := 0;
+    firstgpr := RS_R31;
+    if not (po_assembler in current_procinfo.procdef.procoptions) then begin
+      for reg := RS_R14 to RS_R31 do begin
+        if reg in rg[R_INTREGISTER].used_in_proc then begin
+          gprcount := ord(RS_R31)-ord(reg)+1;
+          firstgpr := reg;
+          break;
+        end;
+      end;
+    end;
+  end;
+
+{ This procedure may be called before, as well as after g_stackframe_entry }
+{ is called. NOTE registers are not to be allocated through the register   }
+{ allocator here, because the register colouring has already occured !!    }
+
+var
+  regcount, firstregfpu, firstreggpr: TSuperRegister;
+  href: treference;
+  needslinkreg : boolean;
+  localsize,
+  fprcount, gprcount: aint;
+begin
+  calcFirstUsedFPR(firstregfpu, fprcount);
+  calcFirstUsedGPR(firstreggpr, gprcount);
+
+  // determine whether we need to restore the link register
+  needslinkreg := ((not (po_assembler in current_procinfo.procdef.procoptions)) and
+    (pi_do_call in current_procinfo.flags));
+  // calculate stack frame
+  localsize := tppcprocinfo(current_procinfo).calc_stackframe_size(
+    gprcount, fprcount);
+
+  // CR register not supported
+
+  // restore stack pointer
+  if (not nostackframe) and (localsize > 0) then begin
+    if (localsize <= high(smallint)) then begin
+      list.concat(taicpu.op_reg_reg_const(A_ADDI, NR_STACK_POINTER_REG, NR_STACK_POINTER_REG, localsize));
+    end else begin
+      reference_reset_base(href, NR_NO, localsize);
+
+      // use R0 for loading the constant (which is definitely > 32k when entering
+      // this branch)
+      // inlined because it must not use temp registers because register allocations
+      // have already been done :(
+      { Code template:
+      lis   r0,ofs@highest
+      ori   r0,ofs@higher
+      sldi  r0,r0,32
+      oris  r0,r0,ofs@h
+      ori   r0,r0,ofs@l
+      }
+      list.concat(taicpu.op_reg_const(A_LIS, NR_R0, word(href.offset shr 48)));
+      list.concat(taicpu.op_reg_reg_const(A_ORI, NR_R0, NR_R0, word(href.offset shr 32)));
+      list.concat(taicpu.op_reg_reg_const(A_SLDI, NR_R0, NR_R0, 32));
+      list.concat(taicpu.op_reg_reg_const(A_ORIS, NR_R0, NR_R0, word(href.offset shr 16)));
+      list.concat(taicpu.op_reg_reg_const(A_ORI, NR_R0, NR_R0, word(href.offset)));
+
+      list.concat(taicpu.op_reg_reg_reg(A_ADD, NR_R1, NR_R1, NR_R0));
+    end;
+  end;
+
+  // load registers, FPR first, then GPR
+  {$note ts:todo change order of loading}
+  reference_reset_base(href, NR_STACK_POINTER_REG, -tcgsize2size[OS_FLOAT]);
+  if (fprcount > 0) then begin
+    for regcount := RS_F31 downto firstregfpu do begin
+      a_loadfpu_ref_reg(list, OS_FLOAT, href, newreg(R_FPUREGISTER, regcount,
+        R_SUBNONE));
+      dec(href.offset, tcgsize2size[OS_FLOAT]);
+    end;
+  end;
+  if (gprcount > 0) then begin
+    for regcount := RS_R31 downto firstreggpr do begin
+      a_load_ref_reg(list, OS_INT, OS_INT, href, newreg(R_INTREGISTER, regcount,
+        R_SUBNONE));
+      dec(href.offset, tcgsize2size[OS_INT]);
+    end;
+  end;
+
+  // VMX not supported...
+
+  // restore LR (if needed)
+  if (needslinkreg) then begin
+    reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_ELF);
+    list.concat(taicpu.op_reg_ref(A_LD, NR_R0, href));
+    list.concat(taicpu.op_reg(A_MTLR, NR_R0));
+  end;
+
+  // generate return instruction
+  list.concat(taicpu.op_none(A_BLR));
+end;
+
+
+procedure tcgppc.a_loadaddr_ref_reg(list: taasmoutput; const ref: treference; r:
+  tregister);
+
+var
+  ref2, tmpref: treference;
+  // register used to construct address
+  tempreg : TRegister;
+
+begin
+  ref2 := ref;
+  fixref(list, ref2);
+  { load a symbol }
+  if assigned(ref2.symbol) or (ref2.offset < low(smallint)) or (ref2.offset > high(smallint)) then begin
+      { add the symbol's value to the base of the reference, and if the }
+      { reference doesn't have a base, create one                       }
+      reference_reset(tmpref);
+      tmpref.offset := ref2.offset;
+      tmpref.symbol := ref2.symbol;
+      tmpref.relsymbol := ref2.relsymbol;
+      // load 64 bit reference into r. If the reference already has a base register,
+      // first load the 64 bit value into a temp register, then add it to the result
+      // register rD
+      if (ref2.base <> NR_NO) then begin
+        // already have a base register, so allocate a new one
+        tempreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
+      end else begin
+        tempreg := r;
+      end;
+
+      // code for loading a reference from a symbol into a register rD.
+      (*
+      lis   rX,SYM@highest
+      ori   rX,SYM@higher
+      sldi  rX,rX,32
+      oris  rX,rX,SYM@h
+      ori   rX,rX,SYM@l
+      *)
+      tmpref.refaddr := addr_highest;
+      list.concat(taicpu.op_reg_ref(A_LIS, tempreg, tmpref));
+      tmpref.refaddr := addr_higher;
+      list.concat(taicpu.op_reg_reg_ref(A_ORI, tempreg, tempreg, tmpref));
+      list.concat(taicpu.op_reg_reg_const(A_SLDI, tempreg, tempreg, 32));
+      tmpref.refaddr := addr_high;
+      list.concat(taicpu.op_reg_reg_ref(A_ORIS, tempreg, tempreg, tmpref));
+      tmpref.refaddr := addr_low;
+      list.concat(taicpu.op_reg_reg_ref(A_ORI, tempreg, tempreg, tmpref));
+
+      // if there's already a base register, add the temp register contents to
+      // the base register
+      if (ref2.base <> NR_NO) then begin
+        list.concat(taicpu.op_reg_reg_reg(A_ADD, r, tempreg, ref2.base));
+      end;
+  end else if ref2.offset <> 0 then begin
+    { no symbol, but offset <> 0 }
+    if ref2.base <> NR_NO then begin
+      a_op_const_reg_reg(list, OP_ADD, OS_64, ref2.offset, ref2.base, r)
+      { FixRef makes sure that "(ref.index <> R_NO) and (ref.offset <> 0)" never}
+      { occurs, so now only ref.offset has to be loaded                         }
+    end else begin
+      a_load_const_reg(list, OS_64, ref2.offset, r)
+    end;
+  end else if ref.index <> NR_NO then
+    list.concat(taicpu.op_reg_reg_reg(A_ADD, r, ref2.base, ref2.index))
+  else if (ref2.base <> NR_NO) and
+    (r <> ref2.base) then
+    a_load_reg_reg(list, OS_ADDR, OS_ADDR, ref2.base, r)
+  else begin
+    list.concat(taicpu.op_reg_const(A_LI, r, 0));
+  end;
+end;
+
+{ ************* concatcopy ************ }
+
+const
+  maxmoveunit = 8;
+
+
+procedure tcgppc.g_concatcopy(list: taasmoutput; const source, dest: treference;
+  len: aint);
+
+var
+  countreg, tempreg: TRegister;
+  src, dst: TReference;
+  lab: tasmlabel;
+  count, count2: longint;
+  size: tcgsize;
+
+begin
+{$IFDEF extdebug}
+  if len > high(aint) then
+    internalerror(2002072704);
+{$ENDIF extdebug}
+  { make sure short loads are handled as optimally as possible }
+
+  if (len <= maxmoveunit) and
+    (byte(len) in [1, 2, 4, 8]) then
+  begin
+    if len < 8 then
+    begin
+      size := int_cgsize(len);
+      a_load_ref_ref(list, size, size, source, dest);
+    end
+    else
+    begin
+      a_reg_alloc(list, NR_F0);
+      a_loadfpu_ref_reg(list, OS_F64, source, NR_F0);
+      a_loadfpu_reg_ref(list, OS_F64, NR_F0, dest);
+      a_reg_dealloc(list, NR_F0);
+    end;
+    exit;
+  end;
+
+  count := len div maxmoveunit;
+
+  reference_reset(src);
+  reference_reset(dst);
+  { load the address of source into src.base }
+  if (count > 4) or
+    not issimpleref(source) or
+    ((source.index <> NR_NO) and
+    ((source.offset + len) > high(smallint))) then begin
+    src.base := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
+    a_loadaddr_ref_reg(list, source, src.base);
+  end else begin
+    src := source;
+  end;
+  { load the address of dest into dst.base }
+  if (count > 4) or
+    not issimpleref(dest) or
+    ((dest.index <> NR_NO) and
+    ((dest.offset + len) > high(smallint))) then begin
+    dst.base := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
+    a_loadaddr_ref_reg(list, dest, dst.base);
+  end else begin
+    dst := dest;
+  end;
+
+  { generate a loop }
+  if count > 4 then begin
+    { the offsets are zero after the a_loadaddress_ref_reg and just }
+    { have to be set to 8. I put an Inc there so debugging may be   }
+    { easier (should offset be different from zero here, it will be }
+    { easy to notice in the generated assembler                     }
+    inc(dst.offset, 8);
+    inc(src.offset, 8);
+    list.concat(taicpu.op_reg_reg_const(A_SUBI, src.base, src.base, 8));
+    list.concat(taicpu.op_reg_reg_const(A_SUBI, dst.base, dst.base, 8));
+    countreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
+    a_load_const_reg(list, OS_32, count, countreg);
+    { explicitely allocate R_0 since it can be used safely here }
+    { (for holding date that's being copied)                    }
+    a_reg_alloc(list, NR_F0);
+    objectlibrary.getjumplabel(lab);
+    a_label(list, lab);
+    list.concat(taicpu.op_reg_reg_const(A_SUBIC_, countreg, countreg, 1));
+    list.concat(taicpu.op_reg_ref(A_LFDU, NR_F0, src));
+    list.concat(taicpu.op_reg_ref(A_STFDU, NR_F0, dst));
+    a_jmp(list, A_BC, C_NE, 0, lab);
+    a_reg_dealloc(list, NR_F0);
+    len := len mod 8;
+  end;
+
+  count := len div 8;
+  { unrolled loop }
+  if count > 0 then begin
+    a_reg_alloc(list, NR_F0);
+    for count2 := 1 to count do begin
+      a_loadfpu_ref_reg(list, OS_F64, src, NR_F0);
+      a_loadfpu_reg_ref(list, OS_F64, NR_F0, dst);
+      inc(src.offset, 8);
+      inc(dst.offset, 8);
+    end;
+    a_reg_dealloc(list, NR_F0);
+    len := len mod 8;
+  end;
+
+  if (len and 4) <> 0 then begin
+    a_reg_alloc(list, NR_R0);
+    a_load_ref_reg(list, OS_32, OS_32, src, NR_R0);
+    a_load_reg_ref(list, OS_32, OS_32, NR_R0, dst);
+    inc(src.offset, 4);
+    inc(dst.offset, 4);
+    a_reg_dealloc(list, NR_R0);
+  end;
+  { copy the leftovers }
+  if (len and 2) <> 0 then begin
+    a_reg_alloc(list, NR_R0);
+    a_load_ref_reg(list, OS_16, OS_16, src, NR_R0);
+    a_load_reg_ref(list, OS_16, OS_16, NR_R0, dst);
+    inc(src.offset, 2);
+    inc(dst.offset, 2);
+    a_reg_dealloc(list, NR_R0);
+  end;
+  if (len and 1) <> 0 then begin
+    a_reg_alloc(list, NR_R0);
+    a_load_ref_reg(list, OS_8, OS_8, src, NR_R0);
+    a_load_reg_ref(list, OS_8, OS_8, NR_R0, dst);
+    a_reg_dealloc(list, NR_R0);
+  end;
+
+end;
+
+procedure tcgppc.g_overflowcheck(list: taasmoutput; const l: tlocation; def:
+  tdef);
+var
+  hl: tasmlabel;
+  flags : TResFlags;
+begin
+  if not (cs_check_overflow in aktlocalswitches) then
+    exit;
+  objectlibrary.getjumplabel(hl);
+  if not ((def.deftype = pointerdef) or
+    ((def.deftype = orddef) and
+    (torddef(def).typ in [u64bit, u16bit, u32bit, u8bit, uchar,
+    bool8bit, bool16bit, bool32bit]))) then
+  begin
+    // ... instruction setting overflow flag ...
+    // mfxerf R0
+    // mtcrf 128, R0
+    // ble cr0, label
+    list.concat(taicpu.op_reg(A_MFXER, NR_R0));
+    list.concat(taicpu.op_const_reg(A_MTCRF, 128, NR_R0));
+    flags.cr := RS_CR0;
+    flags.flag := F_LE;
+    a_jmp_flags(list, flags, hl);
+  end else
+    a_jmp_cond(list, OC_AE, hl);
+  a_call_name(list, 'FPC_OVERFLOW');
+  a_label(list, hl);
+end;
+
+procedure tcgppc.g_intf_wrapper(list: TAAsmoutput; procdef: tprocdef; const
+  labelname: string; ioffset: longint);
+
+  procedure loadvmttor11;
+  var
+    href: treference;
+  begin
+    reference_reset_base(href, NR_R3, 0);
+    cg.a_load_ref_reg(list, OS_ADDR, OS_ADDR, href, NR_R11);
+  end;
+
+  procedure op_onr11methodaddr;
+  var
+    href: treference;
+  begin
+    if (procdef.extnumber = $FFFF) then
+      Internalerror(200006139);
+    { call/jmp  vmtoffs(%eax) ; method offs }
+    reference_reset_base(href, NR_R11,
+      procdef._class.vmtmethodoffset(procdef.extnumber));
+    if not ((aint(href.offset) >= low(smallint)) and
+      (aint(href.offset) <= high(smallint))) then begin
+      {$warning ts:adapt me}
+      list.concat(taicpu.op_reg_reg_const(A_ADDIS, NR_R11, NR_R11,
+        smallint((href.offset shr 16) + ord(smallint(href.offset and $FFFF) <
+        0))));
+      href.offset := smallint(href.offset and $FFFF);
+    end;
+    list.concat(taicpu.op_reg_ref(A_LD, NR_R11, href));
+    // the loaded reference is a function descriptor reference, so deref again
+    // (at ofs 0 there's the real pointer)
+    {$warning ts:TODO: update GOT reference}
+    reference_reset_base(href, NR_R11, 0);
+    list.concat(taicpu.op_reg_ref(A_LD, NR_R11, href));
+
+    list.concat(taicpu.op_reg(A_MTCTR, NR_R11));
+    list.concat(taicpu.op_none(A_BCTR));
+    // NOP needed for the linker...?
+    list.concat(taicpu.op_none(A_NOP));
+  end;
+
+var
+  make_global: boolean;
+begin
+  if (not (procdef.proctypeoption in [potype_function, potype_procedure])) then
+    Internalerror(200006137);
+  if not assigned(procdef._class) or
+    (procdef.procoptions * [po_classmethod, po_staticmethod,
+    po_methodpointer, po_interrupt, po_iocheck] <> []) then
+    Internalerror(200006138);
+  if procdef.owner.symtabletype <> objectsymtable then
+    Internalerror(200109191);
+
+  make_global := false;
+  if (not current_module.is_unit) or
+    (cs_create_smart in aktmoduleswitches) or
+    (procdef.owner.defowner.owner.symtabletype = globalsymtable) then
+    make_global := true;
+
+  if make_global then
+    List.concat(Tai_symbol.Createname_global(labelname, AT_FUNCTION, 0))
+  else
+    List.concat(Tai_symbol.Createname(labelname, AT_FUNCTION, 0));
+
+  { set param1 interface to self  }
+  g_adjust_self_value(list, procdef, ioffset);
+
+  { case 4 }
+  if po_virtualmethod in procdef.procoptions then begin
+    loadvmttor11;
+    op_onr11methodaddr;
+  end { case 0 } else
+    {$note ts:todo add GOT change?? - think not needed :) }
+    list.concat(taicpu.op_sym(A_B,
+      objectlibrary.newasmsymbol('.' + procdef.mangledname, AB_EXTERNAL,
+      AT_FUNCTION)));
+
+  List.concat(Tai_symbol_end.Createname(labelname));
+end;
+
+{***************** This is private property, keep out! :) *****************}
+
+function tcgppc.issimpleref(const ref: treference): boolean;
+
+begin
+  if (ref.base = NR_NO) and
+    (ref.index <> NR_NO) then
+    internalerror(200208101);
+  result :=
+    not (assigned(ref.symbol)) and
+    (((ref.index = NR_NO) and
+    (ref.offset >= low(smallint)) and
+    (ref.offset <= high(smallint))) or
+    ((ref.index <> NR_NO) and
+    (ref.offset = 0)));
+end;
+
+function tcgppc.fixref(list: taasmoutput; var ref: treference): boolean;
+
+var
+  tmpreg: tregister;
+begin
+  result := false;
+  if (ref.base = NR_NO) then
+  begin
+    ref.base := ref.index;
+    ref.base := NR_NO;
+  end;
+  if (ref.base <> NR_NO) then
+  begin
+    if (ref.index <> NR_NO) and
+      ((ref.offset <> 0) or assigned(ref.symbol)) then
+    begin
+      result := true;
+      tmpreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
+      list.concat(taicpu.op_reg_reg_reg(
+        A_ADD, tmpreg, ref.base, ref.index));
+      ref.index := NR_NO;
+      ref.base := tmpreg;
+    end
+  end
+  else if ref.index <> NR_NO then
+    internalerror(200208102);
+end;
+
+procedure tcgppc.a_load_store(list: taasmoutput; op: tasmop; reg: tregister;
+  ref: treference);
+
+var
+  tmpreg: tregister;
+  tmpref: treference;
+  largeOffset: Boolean;
+
+begin
+  tmpreg := NR_NO;
+
+  // if we have to load/store from a symbol or large addresses, use a temporary register
+  // containing the address
+    if assigned(ref.symbol) or (ref.offset < low(smallint)) or (ref.offset > high(smallint)) then begin
+      tmpreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
+      reference_reset(tmpref);
+      tmpref.symbol := ref.symbol;
+      tmpref.relsymbol := ref.relsymbol;
+      tmpref.offset := ref.offset;
+
+      (*
+      code template when there's no base register
+
+      lis rT,SYM+offs@highesta
+      addi rT,SYM+offs@highera
+      sldi rT,rT,32
+      addis rT,rT,SYM+offs@ha
+      ld rD,SYM+offs@l(rT)
+
+      code template when there's a base register
+
+      lis rT,SYM+offs@highesta
+      addis rT,SYM+offs@highera
+      sldi rT,rT,32
+      addis rT,rT,SYM+offs@ha
+      add  rT,rBase,rT
+      ld rD,SYM+offs@l(rT)
+
+      *)
+      //list.concat(tai_comment.create(strpnew('symbol: ' + tmpref.symbol.name + ' offset: ' + inttostr(tmpref.offset))));
+
+      tmpref.refaddr := addr_highesta;
+      list.concat(taicpu.op_reg_ref(A_LIS, tmpreg, tmpref));
+      tmpref.refaddr := addr_highera;
+      list.concat(taicpu.op_reg_reg_ref(A_ORI, tmpreg, tmpreg, tmpref));
+      list.concat(taicpu.op_reg_reg_const(A_SLDI, tmpreg, tmpreg, 32));
+      tmpref.refaddr := addr_higha;
+      list.concat(taicpu.op_reg_reg_ref(A_ORIS, tmpreg, tmpreg, tmpref));
+
+      if (ref.base <> NR_NO) then begin
+        list.concat(taicpu.op_reg_reg_reg(A_ADD, tmpreg, tmpreg, ref.base));
+      end;
+
+      tmpref.base := tmpreg;
+      tmpref.refaddr := addr_low;
+      list.concat(taicpu.op_reg_ref(op, reg, tmpref));
+    end else begin
+      list.concat(taicpu.op_reg_ref(op, reg, ref));
+    end;
+end;
+
+procedure tcgppc.a_jmp(list: taasmoutput; op: tasmop; c: tasmcondflag;
+  crval: longint; l: tasmlabel);
+var
+  p: taicpu;
+
+begin
+  p := taicpu.op_sym(op, objectlibrary.newasmsymbol(l.name, AB_EXTERNAL,
+    AT_LABEL));
+  if op <> A_B then
+    create_cond_norm(c, crval, p.condition);
+  p.is_jmp := true;
+  list.concat(p)
+end;
+
+begin
+  cg := tcgppc.create;
+end.

compiler/powerpc64/nppccnv.pas

@@ -0,0 +1,303 @@
+{
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    Generate PowerPC assembler for type converting nodes
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    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.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit nppccnv;
+
+{$I fpcdefs.inc}
+
+interface
+
+uses
+  node, ncnv, ncgcnv, defcmp;
+
+type
+  tppctypeconvnode = class(tcgtypeconvnode)
+  protected
+    { procedure second_int_to_int;override; }
+    { procedure second_string_to_string;override; }
+    { procedure second_cstring_to_pchar;override; }
+    { procedure second_string_to_chararray;override; }
+    { procedure second_array_to_pointer;override; }
+    function first_int_to_real: tnode; override;
+    { procedure second_pointer_to_array;override; }
+    { procedure second_chararray_to_string;override; }
+    { procedure second_char_to_string;override; }
+    procedure second_int_to_real; override;
+    { procedure second_real_to_real; override;}
+    { procedure second_cord_to_pointer;override; }
+    { procedure second_proc_to_procvar;override; }
+    { procedure second_bool_to_int;override; }
+    procedure second_int_to_bool; override;
+    { procedure second_load_smallset;override;  }
+    { procedure second_ansistring_to_pchar;override; }
+    { procedure second_pchar_to_string;override; }
+    { procedure second_class_to_intf;override; }
+    { procedure second_char_to_char;override; }
+  end;
+
+implementation
+
+uses
+  verbose, globtype, globals, systems,
+  symconst, symdef, aasmbase, aasmtai,
+  defutil,
+  cgbase, cgutils, pass_1, pass_2,
+  ncon, ncal,
+  ncgutil,
+  cpubase, aasmcpu,
+  rgobj, tgobj, cgobj;
+
+{*****************************************************************************
+                             FirstTypeConv
+*****************************************************************************}
+
+function tppctypeconvnode.first_int_to_real: tnode;
+begin
+  if (is_currency(left.resulttype.def)) then begin
+    // hack to avoid double division by 10000, as it's
+    // already done by resulttypepass.resulttype_int_to_real
+    left.resulttype := s64inttype;
+  end else begin
+    // everything that is less than 64 bits is converted to a 64 bit signed
+    // integer - because the int_to_real conversion is faster for 64 bit
+    // signed ints compared to 64 bit unsigned ints.
+    if (not (torddef(left.resulttype.def).typ in [s64bit, u64bit])) then begin
+      inserttypeconv(left, s64inttype);
+    end;
+  end;
+  firstpass(left);
+  result := nil;
+  if registersfpu < 1 then
+    registersfpu := 1;
+  expectloc := LOC_FPUREGISTER;
+end;
+
+{*****************************************************************************
+                             SecondTypeConv
+*****************************************************************************}
+
+procedure tppctypeconvnode.second_int_to_real;
+const
+  convconst : double = $100000000;
+var
+  tempconst : trealconstnode;
+  disp, disp2: treference;
+  // temp registers for converting signed ints
+  valuereg, leftreg,
+  // additional temp registers for converting unsigned 64 bit ints
+  tmpintreg1, tmpintreg2, tmpfpureg, tmpfpuconst : tregister;
+  size: tcgsize;
+  signed: boolean;
+begin
+
+  location_reset(location, LOC_FPUREGISTER, def_cgsize(resulttype.def));
+
+  { the code here comes from the PowerPC Compiler Writer's Guide }
+  { * longint to double (works for all rounding modes) }
+  { std   R3,disp(R1) # store doubleword }
+  { lfd   FR1,disp(R1) # load float double }
+  { fcfid FR1,FR1 # convert to floating-point integer  }
+
+  { * unsigned 64 bit int to fp value (works for all rounding modes) }
+  { rldicl rT1,rS,32,32 # isolate high half }
+  { rldicl rT2,rS,0,32 # isolate low half }
+  { std rT1,disp(R1) # store high half }
+  { std rT2,disp+8(R1) # store low half }
+  { lfd frT1,disp(R1) # load high half }
+  { lfd frD,disp+8(R1) # load low half }
+  { fcfid frT1,frT1 # convert each half to floating }
+  { fcfid frD,frD # point integer (no round) }
+  { fmadd frD,frC,frT1,frD # (2^32)*high + low }
+  { # (only add can round) }
+  tg.Gettemp(exprasmlist, 8, tt_normal, disp);
+
+  { do the signed case for everything but 64 bit unsigned integers }
+  signed := (left.location.size <> OS_64);
+
+  { we need a certain constant for the conversion of unsigned 64 bit integers,
+    so create them here. Additonally another temporary location is neeted }
+  if (not signed) then begin
+    // allocate temp for constant value used for unsigned 64 bit ints
+    tempconst :=
+      crealconstnode.create(convconst, pbestrealtype^);
+    resulttypepass(tempconst);
+    firstpass(tempconst);
+    secondpass(tempconst);
+    if (tempconst.location.loc <> LOC_CREFERENCE) then
+      internalerror(200110011);
+
+    // allocate second temp memory
+    tg.Gettemp(exprasmlist, 8, tt_normal, disp2);
+  end;
+
+  case left.location.loc of
+    // the conversion algorithm does not modify the input register, so it can
+    // be used for both LOC_REGISTER and LOC_CREGISTER
+    LOC_REGISTER, LOC_CREGISTER:
+      begin
+        leftreg := left.location.register;
+        valuereg := leftreg;
+      end;
+    LOC_REFERENCE, LOC_CREFERENCE:
+      begin
+        leftreg := cg.getintregister(exprasmlist, OS_INT);
+        valuereg := leftreg;
+        if signed then
+          size := OS_S64
+        else
+          size := OS_64;
+        cg.a_load_ref_reg(exprasmlist, def_cgsize(left.resulttype.def),
+          size, left.location.reference, leftreg);
+      end
+  else
+    internalerror(200110012);
+  end;
+
+  if (signed) then begin
+    // std rS, disp(r1)
+    cg.a_load_reg_ref(exprasmlist, OS_S64, OS_S64, valuereg, disp);
+    // lfd frD, disp(r1)
+    location.register := cg.getfpuregister(exprasmlist,OS_F64);
+    cg.a_loadfpu_ref_reg(exprasmlist,OS_F64, disp, location.register);
+    // fcfid frD, frD
+    exprasmlist.concat(taicpu.op_reg_reg(A_FCFID, location.register,
+      location.register));
+  end else begin
+    { ts:todo use TOC for this constant or at least schedule better }
+    // lfd frC, const
+    tmpfpuconst := cg.getfpuregister(exprasmlist,OS_F64);
+    cg.a_loadfpu_ref_reg(exprasmlist,OS_F64,tempconst.location.reference,
+      tmpfpuconst);
+    tempconst.free;
+
+    tmpintreg1 := cg.getintregister(exprasmlist, OS_64);
+    // rldicl rT1, rS, 32, 32
+    exprasmlist.concat(taicpu.op_reg_reg_const_const(A_RLDICL, tmpintreg1, valuereg, 32, 32));
+    // rldicl rT2, rS, 0, 32
+    tmpintreg2 := cg.getintregister(exprasmlist, OS_64);
+    exprasmlist.concat(taicpu.op_reg_reg_const_const(A_RLDICL, tmpintreg2, valuereg, 0, 32));
+
+    // std rT1, disp(r1)
+    cg.a_load_reg_ref(exprasmlist, OS_S64, OS_S64, tmpintreg1, disp);
+    // std rT2, disp2(r1)
+    cg.a_load_reg_ref(exprasmlist, OS_S64, OS_S64, tmpintreg2, disp2);
+
+    // lfd frT1, disp(R1)
+    tmpfpureg := cg.getfpuregister(exprasmlist,OS_F64);
+    cg.a_loadfpu_ref_reg(exprasmlist,OS_F64, disp, tmpfpureg);
+    // lfd frD, disp+8(R1)
+    location.register := cg.getfpuregister(exprasmlist,OS_F64);
+    cg.a_loadfpu_ref_reg(exprasmlist,OS_F64, disp2, location.register);
+
+    // fcfid frT1, frT1
+    exprasmlist.concat(taicpu.op_reg_reg(A_FCFID, tmpfpureg,
+      tmpfpureg));
+    // fcfid frD, frD
+    exprasmlist.concat(taicpu.op_reg_reg(A_FCFID, location.register,
+      location.register));
+    // fmadd frD,frC,frT1,frD # (2^32)*high + low }
+    exprasmlist.concat(taicpu.op_reg_reg_reg_reg(A_FMADD, location.register, tmpfpuconst,
+      tmpfpureg, location.register));
+
+    // free used temps
+    tg.ungetiftemp(exprasmlist, disp2);
+  end;
+  // free reference
+  tg.ungetiftemp(exprasmlist, disp);
+
+end;
+
+procedure tppctypeconvnode.second_int_to_bool;
+var
+  hreg1,
+    hreg2: tregister;
+  resflags: tresflags;
+  opsize: tcgsize;
+  hlabel, oldtruelabel, oldfalselabel: tasmlabel;
+begin
+  oldtruelabel := truelabel;
+  oldfalselabel := falselabel;
+  objectlibrary.getjumplabel(truelabel);
+  objectlibrary.getjumplabel(falselabel);
+  secondpass(left);
+  if codegenerror then
+    exit;
+
+  { byte(boolean) or word(wordbool) or longint(longbool) must }
+  { be accepted for var parameters                            }
+  if (nf_explicit in flags) and
+    (left.resulttype.def.size = resulttype.def.size) and
+    (left.location.loc in [LOC_REFERENCE, LOC_CREFERENCE, LOC_CREGISTER]) then
+  begin
+    truelabel := oldtruelabel;
+    falselabel := oldfalselabel;
+    location_copy(location, left.location);
+    exit;
+  end;
+
+  location_reset(location, LOC_REGISTER, def_cgsize(resulttype.def));
+  opsize := def_cgsize(left.resulttype.def);
+  case left.location.loc of
+    LOC_CREFERENCE, LOC_REFERENCE, LOC_REGISTER, LOC_CREGISTER:
+      begin
+        if left.location.loc in [LOC_CREFERENCE, LOC_REFERENCE] then
+        begin
+          hreg1 := cg.getintregister(exprasmlist, OS_INT);
+          cg.a_load_ref_reg(exprasmlist, opsize, opsize,
+            left.location.reference, hreg1);
+        end
+        else
+        begin
+          hreg1 := left.location.register;
+        end;
+        hreg2 := cg.getintregister(exprasmlist, OS_INT);
+        exprasmlist.concat(taicpu.op_reg_reg_const(A_SUBIC, hreg2, hreg1, 1));
+        exprasmlist.concat(taicpu.op_reg_reg_reg(A_SUBFE, hreg1, hreg2, hreg1));
+      end;
+    LOC_FLAGS:
+      begin
+        hreg1 := cg.getintregister(exprasmlist, OS_INT);
+        resflags := left.location.resflags;
+        cg.g_flags2reg(exprasmlist, location.size, resflags, hreg1);
+      end;
+    LOC_JUMP:
+      begin
+        hreg1 := cg.getintregister(exprasmlist, OS_INT);
+        objectlibrary.getjumplabel(hlabel);
+        cg.a_label(exprasmlist, truelabel);
+        cg.a_load_const_reg(exprasmlist, OS_INT, 1, hreg1);
+        cg.a_jmp_always(exprasmlist, hlabel);
+        cg.a_label(exprasmlist, falselabel);
+        cg.a_load_const_reg(exprasmlist, OS_INT, 0, hreg1);
+        cg.a_label(exprasmlist, hlabel);
+      end;
+  else
+    internalerror(10062);
+  end;
+  location.register := hreg1;
+  truelabel := oldtruelabel;
+  falselabel := oldfalselabel;
+end;
+
+begin
+  ctypeconvnode := tppctypeconvnode;
+end.
+

rtl/linux/Makefile.fpc

@@ -0,0 +1,317 @@
+#
+#   Makefile.fpc for Free Pascal Linux RTL
+#
+
+[package]
+main=rtl
+
+[target]
+loaders=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+units=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil \
+      heaptrc lineinfo \
+      $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) \
+       crt  printer $(GGIGRAPH_UNIT) \
+      sysutils typinfo math matrix varutils \
+      charset ucomplex getopts \
+      errors sockets gpm ipc serial terminfo dl dynlibs \
+      video mouse keyboard variants types dateutils sysconst \
+      cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit
+
+rsts=math varutils typinfo variants sysconst rtlconsts fpmkunit
+
+[require]
+nortl=y
+
+[clean]
+units=syslinux linux
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+target=linux
+
+[compiler]
+includedir=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+sourcedir=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET) $(COMMON)
+targetdir=.
+
+[lib]
+libname=libfprtl.so
+libversion=2.0.0
+libunits=$(SYSTEMUNIT) objpas strings \
+      unix  ports \
+      dos crt objects printer \
+      sysutils typinfo math \
+      cpu mmx getopts heaptrc \
+      errors sockets ipc dl dynlibs varutils
+
+[prerules]
+RTL=..
+INC=$(RTL)/inc
+COMMON=$(RTL)/common
+PROCINC=$(RTL)/$(CPU_TARGET)
+UNIXINC=$(RTL)/unix
+
+ifneq ($(CPU_TARGET),powerpc64)
+GGIGRAPH_UNIT=ggigraph
+else
+GGIGRAPH_UNIT=
+endif
+
+ifeq ($(CPU_TARGET),i386)
+CRT21=cprt21 gprt21
+CPU_UNITS=x86 ports cpu mmx graph
+else
+CPU_UNITS=
+endif
+
+UNITPREFIX=rtl
+
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+SYSTEMUNIT=system
+LINUXUNIT1=
+ifeq ($(CPU_TARGET),i386)
+CPU_UNITS+=oldlinux
+endif
+LINUXUNIT2=linux
+else
+SYSTEMUNIT=syslinux
+LINUXUNIT1=linux
+LINUXUNIT2=
+override FPCOPT+=-dUNIX
+endif
+
+# Use new feature from 1.0.5 version
+# that generates release PPU files
+# which will not be recompiled
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+
+# Paths
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+
+# Use new graph unit ?
+# NEWGRAPH=YES
+# Use LibGGI ?
+# Use
+#
+ifndef USELIBGGI
+USELIBGGI=NO
+endif
+
+[rules]
+# Get the $(SYSTEMUNIT) independent include file names.
+# This will set the following variables :
+# SYSINCNAMES
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+
+# Get the processor dependent include file names.
+# This will set the following variables :
+# CPUINCNAMES
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+
+# Put $(SYSTEMUNIT) unit dependencies together.
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+
+# Select 32/64 mode
+ifeq ($(CPU_TARGET),i386)
+  ASTARGET=--32
+endif
+ifeq ($(CPU_TARGET),x86_64)
+  ASTARGET=--64
+endif
+ifeq ($(CPU_TARGET),powerpc64)
+  ASTARGET=-a64
+endif
+
+#
+# Loaders
+#
+
+prt0$(OEXT) : $(CPU_TARGET)/prt0.as
+        $(AS) $(ASTARGET) -o $(UNITTARGETDIRPREFIX)prt0$(OEXT) $(CPU_TARGET)/prt0.as
+
+dllprt0$(OEXT) : $(CPU_TARGET)/dllprt0.as
+        $(AS) $(ASTARGET) -o $(UNITTARGETDIRPREFIX)dllprt0$(OEXT) $(CPU_TARGET)/dllprt0.as
+
+gprt0$(OEXT) : $(CPU_TARGET)/gprt0.as
+        $(AS) $(ASTARGET) -o $(UNITTARGETDIRPREFIX)gprt0$(OEXT) $(CPU_TARGET)/gprt0.as
+
+cprt0$(OEXT) : $(CPU_TARGET)/cprt0.as
+        $(AS) $(ASTARGET) -o $(UNITTARGETDIRPREFIX)cprt0$(OEXT) $(CPU_TARGET)/cprt0.as
+
+cprt21$(OEXT) : $(CPU_TARGET)/cprt21.as
+        $(AS) $(ASTARGET) -o $(UNITTARGETDIRPREFIX)cprt21$(OEXT) $(CPU_TARGET)/cprt21.as
+
+gprt21$(OEXT) : $(CPU_TARGET)/gprt21.as
+        $(AS) $(ASTARGET) -o $(UNITTARGETDIRPREFIX)gprt21$(OEXT) $(CPU_TARGET)/gprt21.as
+
+
+#
+# $(SYSTEMUNIT) Units ($(SYSTEMUNIT), Objpas, Strings)
+#
+
+$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp $(SYSDEPS)
+        $(COMPILER) -Us -Sg $(SYSTEMUNIT).pp
+
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+
+dateutils$(PPUEXT): $(OBJPASDIR)/dateutils.pp $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp
+
+strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
+                   $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
+                   $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# $(SYSTEMUNIT) Dependent Units
+#
+
+unix$(PPUEXT) : unix.pp strings$(PPUEXT) baseunix$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \
+                 unxconst.inc $(UNIXINC)/timezone.inc $(SYSTEMUNIT)$(PPUEXT) \
+                 unxfunc.inc
+
+unixtype$(PPUEXT) : $(UNIXINC)/unixtype.pp ptypes.inc $(UNIXINC)/ctypes.inc $(SYSTEMUNIT)$(PPUEXT)
+
+baseunix$(PPUEXT) : errno.inc ptypes.inc $(UNIXINC)/ctypes.inc \
+  $(UNIXINC)/bunxh.inc \
+  bunxsysc.inc $(CPU_TARGET)/syscallh.inc $(CPU_TARGET)/sysnr.inc \
+  ostypes.inc osmacro.inc $(UNIXINC)/gensigset.inc \
+  $(UNIXINC)/genfuncs.inc $(SYSTEMUNIT)$(PPUEXT)
+
+ports$(PPUEXT) : ports.pp unix$(PPUEXT) objpas$(PPUEXT)
+
+dl$(PPUEXT) : $(UNIXINC)/dl.pp $(SYSTEMUNIT)$(PPUEXT)
+
+dynlibs$(PPUEXT) : $(INC)/dynlibs.pp $(UNIXINC)/dynlibs.inc dl$(PPUEXT) objpas$(PPUEXT)
+
+#
+# TP7 Compatible RTL Units
+#
+
+dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
+               unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+crt$(PPUEXT) : crt.pp $(INC)/textrec.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT)
+
+printer$(PPUEXT) : printer.pp $(INC)/textrec.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# Graph
+#
+include $(GRAPHDIR)/makefile.inc
+GRAPHINCDEPS=$(addprefix $(GRAPHDIR)/,$(GRAPHINCNAMES))
+
+graph$(PPUEXT) : graph.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
+                 $(GRAPHINCDEPS) $(UNIXINC)/graph16.inc
+        $(COMPILER) -I$(GRAPHDIR) $(UNIXINC)/graph.pp
+
+
+ggigraph$(PPUEXT) : $(UNIXINC)/ggigraph.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
+                 $(GRAPHINCDEPS)
+        $(COMPILER) -I$(GRAPHDIR) $(UNIXINC)/ggigraph.pp
+
+#
+# Delphi Compatible Units
+#
+
+sysutils$(PPUEXT) : $(UNIXINC)/sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+                    objpas$(PPUEXT) unix$(PPUEXT) errors$(PPUEXT) sysconst$(PPUEXT)
+        $(COMPILER) -Fi$(OBJPASDIR)/sysutils $(UNIXINC)/sysutils.pp
+
+classes$(PPUEXT) : $(UNIXINC)/classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+                   sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT)
+        $(COMPILER) -Fi$(OBJPASDIR)/classes $(UNIXINC)/classes.pp
+
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) sysutils$(PPUEXT) rtlconsts$(PPUEXT)
+        $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
+
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+        $(COMPILER) $(OBJPASDIR)/math.pp
+
+gettext$(PPUEXT): $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+        $(COMPILER) $(OBJPASDIR)/gettext.pp
+
+varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
+                    $(OBJPASDIR)/varutilh.inc varutils.pp sysutils$(PPUEXT)
+        $(COMPILER) -I$(OBJPASDIR) $(UNIXINC)/varutils.pp
+
+variants$(PPUEXT) : $(INC)/variants.pp sysutils$(PPUEXT) sysconst$(PPUEXT) varutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT)
+        $(COMPILER) -Fi$(INC) $(INC)/variants.pp
+
+types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $(OBJPASDIR)/types.pp
+
+sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $(OBJPASDIR)/sysconst.pp
+
+rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $(OBJPASDIR)/rtlconsts.pp
+
+strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
+                    sysutils$(PPUEXT)
+        $(COMPILER) $(OBJPASDIR)/strutils.pp
+
+#
+# Mac Pascal Model
+#
+
+macpas$(PPUEXT) : $(INC)/macpas.pp $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $(INC)/macpas.pp $(REDIR)
+
+#
+# Other $(SYSTEMUNIT)-independent RTL Units
+#
+
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
+
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
+
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) -Sg $(INC)/heaptrc.pp
+
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
+
+charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
+
+ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+fpmkunit$(PPUEXT) : $(COMMON)/fpmkunit.pp classes$(PPUEXT)
+
+#
+# Other $(SYSTEMUNIT)-dependent RTL Units
+#
+
+sockets$(PPUEXT) : sockets.pp $(INC)/textrec.inc $(INC)/filerec.inc \
+                   unixsock.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+errors$(PPUEXT) : errors.pp strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+ipc$(PPUEXT) : ipc.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+terminfo$(PPUEXT) : terminfo.pp unix$(PPUEXT)
+
+callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
+
+cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
+
+cthreads$(PPUEXT) : $(UNIXINC)/cthreads.pp $(SYSTEMUNIT)$(PPUEXT)
+
+cwstring$(PPUEXT) : $(UNIXINC)/cwstring.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT) baseunix$(PPUEXT) unix$(PPUEXT) unixtype$(PPUEXT) ctypes$(PPUEXT)
+
+gpm$(PPUEXT): gpm.pp unix$(PPUEXT) baseunix$(PPUEXT) sockets$(PPUEXT)
+
+ctypes$(PPUEXT) :  $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT)
+
+fpcylix$(PPUEXT) :  fpcylix.pp $(SYSTEMUNIT)$(PPUEXT) dynlibs$(PPUEXT) objpas$(PPUEXT)

rtl/linux/ipccall.inc

@@ -0,0 +1,118 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2001 by Free Pascal development team
+
+    Linux IPC implemented with ipccall
+
+    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.
+
+ ***********************************************************************}
+{ The following definitions come from linux/ipc.h }
+
+Function ftok (Path : pchar; ID : cint) : TKey;
+Var Info : TStat;
+begin
+  If fpstat(path,info)<0 then
+    ftok:=-1
+  else
+    begin
+    ftok:= (info.st_ino and $FFFF) or ((info.st_dev and $ff) shl 16) or (byte(ID) shl 24)
+    end;
+end;
+
+Const
+  CALL_SEMOP   = 1;
+  CALL_SEMGET  = 2;
+  CALL_SEMCTL  = 3;
+  CALL_MSGSND  = 11;
+  CALL_MSGRCV  = 12;
+  CALL_MSGGET  = 13;
+  CALL_MSGCTL  = 14;
+  CALL_SHMAT   = 21;
+  CALL_SHMDT   = 22;
+  CALL_SHMGET  = 23;
+  CALL_SHMCTL  = 24;
+
+{ generic call that handles all IPC calls }
+
+function ipccall(Call,First,Second,Third : cint; P : Pointer) : ptrint;
+begin
+ ipccall:=do_syscall(syscall_nr_ipc,call,first,second,third,ptrint(P));
+// ipcerror:=fpgetErrno;
+end;
+
+function shmget(key: Tkey; size:cint; flag:cint):cint;
+begin
+  shmget:=ipccall (CALL_SHMGET,key,size,flag,nil);
+end;
+
+Function shmat (shmid:cint; shmaddr:pointer; shmflg:cint):pointer;
+Var raddr : pchar;
+    error : ptrint;
+begin
+  error:=ipccall(CALL_SHMAT,shmid,shmflg,cint(@raddr),shmaddr);
+  If Error<0 then
+    shmat:=pchar(error)
+  else
+    shmat:=raddr;
+end;
+
+function shmdt (shmaddr:pointer): cint;
+begin
+  shmdt:=ipccall(CALL_SHMDT,0,0,0,shmaddr);
+end;
+
+function shmctl(shmid:cint; cmd:cint; buf: pshmid_ds): cint;
+begin
+ shmctl:=ipccall(CALL_SHMCTL,shmid,cmd,0,buf);
+end;
+
+function msgget(key:Tkey; msgflg:cint):cint;
+begin
+  msgget:=ipccall(CALL_MSGGET,key,msgflg,0,Nil);
+end;
+
+function msgsnd(msqid:cint; msgp: PMSGBuf; msgsz: size_t; msgflg:cint):cint;
+begin
+  msgsnd:=ipccall(Call_MSGSND,msqid,msgsz,msgflg,msgp);
+end;
+
+function msgrcv(msqid:cint; msgp: PMSGBuf; msgsz: size_t; msgtyp:cint; msgflg:cint):cint;
+Type
+  TIPC_Kludge = Record
+    msgp   : pmsgbuf;
+    msgtyp : cint;
+  end;
+Var
+   tmp : TIPC_Kludge;
+begin
+  tmp.msgp   := msgp;
+  tmp.msgtyp := msgtyp;
+  msgrcv:=ipccall(CALL_MSGRCV,msqid,msgsz,msgflg,@tmp);
+end;
+
+Function msgctl(msqid:cint; cmd: cint; buf: PMSQid_ds): cint;
+begin
+  msgctl:=ipccall(CALL_MSGCTL,msqid,cmd,0,buf);
+end;
+
+Function semget(key:Tkey; nsems:cint; semflg:cint): cint;
+begin
+  semget:=ipccall (CALL_SEMGET,key,nsems,semflg,Nil);
+end;
+
+Function semop(semid:cint; sops: psembuf; nsops:cuint): cint;
+begin
+  semop:=ipccall (CALL_SEMOP,semid,cint(nsops),0,Pointer(sops));
+end;
+
+Function semctl(semid:cint; semnum:cint; cmd:cint; var arg: tsemun): cint;
+begin
+  semctl:=ipccall(CALL_SEMCTL,semid,semnum,cmd,@arg);
+end;
+

rtl/linux/powerpc64/sighnd.inc

@@ -0,0 +1,54 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Michael Van Canneyt,
+    member of the Free Pascal development team.
+
+    Signal handler is arch dependant due to processor to language
+    exception conversion.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigContext);cdecl;
+var
+  res : word;
+{  fpustate: longint; }
+begin
+  res:=0;
+  writeln('signaltorunerror');
+  { exception flags are turned off by kernel }
+  fpc_enable_ppc_fpu_exceptions;
+  case sig of
+    SIGFPE :
+        begin
+{
+         fpscr is cleared by the kernel -> can't find out cause :(
+          fpustate := fpc_get_ppc_fpscr;
+          if (fpustate and ppc_fpu_underflow) <> 0 then
+            res := 206
+          else if (fpustate and ppc_fpu_overflow) <> 0 then
+            res := 205
+          else if (fpustate and ppc_fpu_divbyzero) <> 0 then
+            res := 200
+          else
+}
+            res := 207;
+        end;
+    SIGBUS :
+        res:=214;
+    SIGILL,
+    SIGSEGV :
+        res:=216;
+  end;
+  { give runtime error at the position where the signal was raised }
+  if res<>0 then
+    HandleErrorAddrFrame(res,pointer(SigContext^.pt_regs^.nip),pointer(SigContext^.pt_regs^.gpr[1]));
+end;
+

rtl/linux/powerpc64/sighndh.inc

@@ -0,0 +1,81 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Jonas Maebe,
+    member of the Free Pascal development team.
+
+    TSigContext
+
+    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.
+
+ **********************************************************************}
+
+{$packrecords C}
+
+type
+  TPPC_Reg = QWord;
+  { from include/asm-ppc64/ptrace.h }
+  pptregs = ^tptregs;
+  tptregs = record
+    gpr: array[0..31] of TPPC_Reg;
+    nip: TPPC_Reg;
+    msr: TPPC_Reg;
+    orig_gpr3: TPPC_Reg; { Used for restarting system calls }
+    ctr: TPPC_Reg;
+    link: TPPC_Reg;
+    xer: TPPC_Reg;
+    ccr: TPPC_Reg;
+    softe: TPPC_Reg;     { soft enabled/disabled  }
+    trap: TPPC_Reg;      { Reason for being here }
+    dar: TPPC_Reg;       { Fault registers }
+    dsisr: TPPC_Reg;
+    result: TPPC_Reg;    { Result of a system call }
+  end;
+
+  { from include/asm-ppc64/signal.h }
+  stack_t = record
+    ss_sp: pointer;
+    ss_flags: longint;
+    ss_size: size_t;
+  end;
+
+  { from include/asm-ppc64/sigcontext.h }
+  tsigcontext_struct = record
+    _unused: array[0..3] of qword;
+    signal: longint;
+    pad0 : longint;
+    handler: qword;
+    oldmask: qword;
+    pt_regs: pptregs;
+  end;
+
+  { from include/asm-ppc64/ucontext.h }
+  pucontext = ^tucontext;
+  tucontext = record
+    uc_flags : qword;
+    uc_link : pucontext;
+    uc_stack : stack_t;
+    uc_sigmask : qword;{sigset_t;}
+    __unused : array[0..14] of qword;{sigset_t;}
+    uc_mcontext : tsigcontext_struct;
+  end;
+
+
+  { from arch/ppc/kernel/signal.c, the type of the actual parameter passed }
+  { to the sigaction handler                                               }
+  t_rt_sigframe = record
+    uc: tucontext;
+    _unused: array[0..1] of qword;
+    tramp: array[0..5] of dword;
+    pinfo: psiginfo;
+    puc: pointer;
+    siginfo: tsiginfo;
+    abigap: array[0..287] of byte;
+  end;
+
+  PSigContext = ^TSigContext;
+  TSigContext= tsigcontext_struct;

rtl/powerpc/powerpc.inc

@@ -0,0 +1,1163 @@
+{
+
+    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
+****************************************************************************}
+{
+
+const
+  ppc_fpu_overflow     = (1 shl (32-3));
+  ppc_fpu_underflow    = (1 shl (32-4));
+  ppc_fpu_divbyzero    = (1 shl (32-5));
+  ppc_fpu_inexact      = (1 shl (32-6));
+  ppc_fpu_invalid_snan = (1 shl (32-7));
+}
+
+procedure fpc_enable_ppc_fpu_exceptions;
+assembler; nostackframe;
+asm
+  { clear all "exception happened" flags we care about}
+  mtfsfi 0,0
+  mtfsfi 1,0
+  mtfsfi 2,0
+  mtfsfi 3,0
+  mtfsb0 21
+  mtfsb0 22
+  mtfsb0 23
+
+  { enable invalid operations and division by zero exceptions. }
+  { No overflow/underflow, since those give some spurious      }
+  { exceptions                                                 }
+  mtfsfi 6,9
+end;
+
+
+procedure fpc_cpuinit;
+begin
+  fpc_enable_ppc_fpu_exceptions;
+end;
+
+
+function fpc_get_ppc_fpscr: cardinal;
+assembler;
+var
+  temp: record a,b:longint; end;
+asm
+  mffs f0
+  stfd f0,temp
+  lwz  r3,temp.b
+  { clear all exception flags }
+{
+  rlwinm r4,r3,0,16,31
+  stw  r4,temp.b
+  lfd  f0,temp
+  a_mtfsf f0
+}
+end;
+
+{ This function is never called directly, it's a dummy to hold the register save/
+  load subroutines
+}
+{$ifndef MACOS}
+label
+  _restfpr_14_x,
+  _restfpr_15_x,
+  _restfpr_16_x,
+  _restfpr_17_x,
+  _restfpr_18_x,
+  _restfpr_19_x,
+  _restfpr_20_x,
+  _restfpr_21_x,
+  _restfpr_22_x,
+  _restfpr_23_x,
+  _restfpr_24_x,
+  _restfpr_25_x,
+  _restfpr_26_x,
+  _restfpr_27_x,
+  _restfpr_28_x,
+  _restfpr_29_x,
+  _restfpr_30_x,
+  _restfpr_31_x,
+  _restfpr_14_l,
+  _restfpr_15_l,
+  _restfpr_16_l,
+  _restfpr_17_l,
+  _restfpr_18_l,
+  _restfpr_19_l,
+  _restfpr_20_l,
+  _restfpr_21_l,
+  _restfpr_22_l,
+  _restfpr_23_l,
+  _restfpr_24_l,
+  _restfpr_25_l,
+  _restfpr_26_l,
+  _restfpr_27_l,
+  _restfpr_28_l,
+  _restfpr_29_l,
+  _restfpr_30_l,
+  _restfpr_31_l;
+
+procedure saverestorereg;assembler; nostackframe;
+asm
+{ exit }
+.globl _restfpr_14_x
+_restfpr_14_x:  lfd     f14, -144(r11)
+.globl _restfpr_15_x
+_restfpr_15_x:  lfd     f15, -136(r11)
+.globl _restfpr_16_x
+_restfpr_16_x:  lfd     f16, -128(r11)
+.globl _restfpr_17_x
+_restfpr_17_x:  lfd     f17, -120(r11)
+.globl _restfpr_18_x
+_restfpr_18_x:  lfd     f18, -112(r11)
+.globl _restfpr_19_x
+_restfpr_19_x:  lfd     f19, -104(r11)
+.globl _restfpr_20_x
+_restfpr_20_x:  lfd     f20, -96(r11)
+.globl _restfpr_21_x
+_restfpr_21_x:  lfd     f21, -88(r11)
+.globl _restfpr_22_x
+_restfpr_22_x:  lfd     f22, -80(r11)
+.globl _restfpr_23_x
+_restfpr_23_x:  lfd     f23, -72(r11)
+.globl _restfpr_24_x
+_restfpr_24_x:  lfd     f24, -64(r11)
+.globl _restfpr_25_x
+_restfpr_25_x:  lfd     f25, -56(r11)
+.globl _restfpr_26_x
+_restfpr_26_x:  lfd     f26, -48(r11)
+.globl _restfpr_27_x
+_restfpr_27_x:  lfd     f27, -40(r11)
+.globl _restfpr_28_x
+_restfpr_28_x:  lfd     f28, -32(r11)
+.globl _restfpr_29_x
+_restfpr_29_x:  lfd     f29, -24(r11)
+.globl _restfpr_30_x
+_restfpr_30_x:  lfd     f30, -16(r11)
+.globl _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 }
+.globl _restfpr_14_l
+_restfpr_14_l:  lfd     f14, -144(r11)
+.globl _restfpr_15_l
+_restfpr_15_l:  lfd     f15, -136(r11)
+.globl _restfpr_16_l
+_restfpr_16_l:  lfd     f16, -128(r11)
+.globl _restfpr_17_l
+_restfpr_17_l:  lfd     f17, -120(r11)
+.globl _restfpr_18_l
+_restfpr_18_l:  lfd     f18, -112(r11)
+.globl _restfpr_19_l
+_restfpr_19_l:  lfd     f19, -104(r11)
+.globl _restfpr_20_l
+_restfpr_20_l:  lfd     f20, -96(r11)
+.globl _restfpr_21_l
+_restfpr_21_l:  lfd     f21, -88(r11)
+.globl _restfpr_22_l
+_restfpr_22_l:  lfd     f22, -80(r11)
+.globl _restfpr_23_l
+_restfpr_23_l:  lfd     f23, -72(r11)
+.globl _restfpr_24_l
+_restfpr_24_l:  lfd     f24, -64(r11)
+.globl _restfpr_25_l
+_restfpr_25_l:  lfd     f25, -56(r11)
+.globl _restfpr_26_l
+_restfpr_26_l:  lfd     f26, -48(r11)
+.globl _restfpr_27_l
+_restfpr_27_l:  lfd     f27, -40(r11)
+.globl _restfpr_28_l
+_restfpr_28_l:  lfd     f28, -32(r11)
+.globl _restfpr_29_l
+_restfpr_29_l:  lfd     f29, -24(r11)
+.globl _restfpr_30_l
+_restfpr_30_l:  lfd     f30, -16(r11)
+.globl _restfpr_31_l
+_restfpr_31_l:  lwz     r0, 4(r11)
+                lfd     f31, -8(r11)
+                mtlr    r0
+                ori     r1, r11, 0
+                blr
+end;
+{$endif MACOS}
+
+{****************************************************************************
+                                Move / Fill
+****************************************************************************}
+
+{$ifndef FPC_SYSTEM_HAS_MOVE}
+{$define FPC_SYSTEM_HAS_MOVE}
+procedure Move(const source;var dest;count:longint);[public, alias: 'FPC_MOVE'];assembler; nostackframe;
+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 < 63 ? (32 + max. alignment (31) }
+          cmpwi   cr7,r5,63
+
+          {  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 }
+          dcbtst  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 r6 := 0, else r6 := -1  }
+          not     r6,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 count < 15, copy everything byte by byte  }
+          blt     cr1,.LMoveBytes
+
+          {  if no 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,r6
+          add     r4,r4,r6
+
+          {  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
+
+{$ifndef ppc603}
+          { check for 32 byte alignment }
+          andi.   r7,r4,31
+{$endif non ppc603}
+          { 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 < 63, copy using dwords }
+          blt     cr7,.LMoveDWords
+
+{$ifndef ppc603}
+          { # of dwords to copy to reach 32 byte alignment (*4) }
+          { (depends on forward/backward copy)                  }
+
+          { if forward copy, r6 = -1 -> r8 := 32 }
+          { if backward copy, r6 = 0 -> r8 := 0  }
+          rlwinm  r8,r6,0,31-6+1,31-6+1
+          { if forward copy, we have to copy 32 - unaligned count bytes }
+          { if backward copy unaligned count bytes                      }
+          sub     r7,r8,r7
+          { if backward copy, the calculated value is now negate -> }
+          { make it positive again                                 }
+          not     r8, r6
+          add     r7, r7, r8
+          xor     r7, r7, r8
+{$endif not ppc603}
+
+          { multiply the update count with 4 }
+          slwi    r10,r10,2
+          slwi    r6,r6,2
+          { and adapt the source and dest }
+          add     r3,r3,r6
+          add     r4,r4,r6
+
+{$ifndef ppc603}
+          beq     cr0,.LMove32BytesAligned
+.L32BytesAlignMoveLoop:
+          {  count >= 39 -> align to 8 byte boundary and then use the FPU  }
+          {  since we're already at 4 byte alignment, use dword store      }
+          subic.  r7,r7,4
+          lwzux   r0,r3,r10
+          subi    r5,r5,4
+          stwux   r0,r4,r10
+          bne     .L32BytesAlignMoveLoop
+
+.LMove32BytesAligned:
+          { count div 32 ( >= 1, since count was >=63 }
+          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                             }
+{$else not ppc603}
+          srwi    r0,r5,4
+          andi.   r5,r5,15
+{$endif not ppc603}
+          cmpwi   cr1,r5,11
+          mtctr   r0
+
+          {  r0 := count div 4, will be moved to ctr when copying dwords  }
+          srwi    r0,r5,2
+
+{$ifndef ppc603}
+          {  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 add r6 we will still have an 8 bytes         }
+          { aligned address)                                                           }
+          add     r3,r3,r6
+          add     r4,r4,r6
+
+          slwi    r6,r6,1
+
+          { the dcbz offset must give a 32 byte aligned address when added   }
+          { to the current dest address and its address must point to the    }
+          { bytes that will be overwritten in the current iteration. In case }
+          { of a forward loop, the dest address has currently an offset of   }
+          { -8 compared to the bytes that will be overwritten (and r6 = -8). }
+          { In case of a backward of a loop, the dest address currently has  }
+          { an offset of +32 compared to the bytes that will be overwritten  }
+          { (and r6 = 0). So the forward dcbz offset must become +8 and the  }
+          { backward -32 -> (-r6 * 5) - 32 gives the correct offset          }
+          slwi    r7,r6,2
+          add     r7,r7,r6
+          neg     r7,r7
+          subi    r7,r7,32
+
+.LMove32ByteDcbz:
+          lfdux   f0,r3,r10
+          lfdux   f1,r3,r10
+          lfdux   f2,r3,r10
+          lfdux   f3,r3,r10
+          { must be done only now, in case source and dest are less than }
+          { 32 bytes apart!                                              }
+          dcbz    r4,r7
+          stfdux  f0,r4,r10
+          stfdux  f1,r4,r10
+          stfdux  f2,r4,r10
+          stfdux  f3,r4,r10
+          bdnz    .LMove32ByteDcbz
+.LMove32ByteLoopDone:
+{$else not ppc603}
+.LMove16ByteLoop:
+          lwzux   r11,r3,r10
+          lwzux   r7,r3,r10
+          lwzux   r8,r3,r10
+          lwzux   r9,r3,r10
+          stwux   r11,r4,r10
+          stwux   r7,r4,r10
+          stwux   r8,r4,r10
+          stwux   r9,r4,r10
+          bdnz    .LMove16ByteLoop
+{$endif not ppc603}
+
+          { 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 }
+          sub     r3,r3,r6
+          sub     r4,r4,r6
+{$ifndef ppc603}
+          srawi   r10,r10,3
+          srawi   r6,r6,3
+{$else not ppc603}
+          srawi   r10,r10,2
+          srawi   r6,r6,2
+{$endif not ppc603}
+
+          { cr1 contains whether count <= 11 }
+          ble     cr1,.LMoveBytes
+
+.LMoveDWords:
+          mtctr   r0
+          andi.   r5,r5,3
+          {  r10 * 4  }
+          slwi    r10,r10,2
+          slwi    r6,r6,2
+          add     r3,r3,r6
+          add     r4,r4,r6
+
+.LMoveDWordsLoop:
+          lwzux   r0,r3,r10
+          stwux   r0,r4,r10
+          bdnz    .LMoveDWordsLoop
+
+          beq     cr0,.LMoveDone
+          {  make r10 again -1 or 1  }
+          sub     r3,r3,r6
+          sub     r4,r4,r6
+          srawi   r10,r10,2
+          srawi   r6,r6,2
+.LMoveBytes:
+          add     r3,r3,r6
+          add     r4,r4,r6
+          mtctr   r5
+.LMoveBytesLoop:
+          lbzux   r0,r3,r10
+          stbux   r0,r4,r10
+          bdnz    .LMoveBytesLoop
+.LMoveDone:
+end;
+{$endif FPC_SYSTEM_HAS_MOVE}
+
+
+{$ifndef FPC_SYSTEM_HAS_FILLCHAR}
+{$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 FPC_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 FPC_ABI_AIX}
+asm
+        { no bytes? }
+        cmpwi     cr6,r4,0
+        { less than 15 bytes? }
+        cmpwi     cr7,r4,15
+        { less than 64 bytes? }
+        cmpwi     cr1,r4,64
+        { 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
+        ble       cr6,.LFillCharDone
+        { get the start of the data in the cache (and mark it as "will be }
+        { modified")                                                      }
+        dcbtst    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+1,31
+        { move to ctr }
+        mtctr     r10
+        { check how many rest there is (to decide whether we'll use }
+        { FillCharSmall or FillCharVerySmall)                       }
+        cmplwi    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         .LFillCharVerySmall
+.LFillCharNoZero:
+{$ifdef FPC_ABI_AIX}
+        stw       r5,-4(r1)
+        stw       r5,-8(r1)
+        lfd       f0,-8(r1)
+{$else FPC_ABI_AIX}
+        stw       r5,temp
+        stw       r5,temp+4
+        lfd       f0,temp
+{$endif FPC_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 }
+        li        r10, 8
+.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
+        { make r3 point again to the actual next byte that must be written }
+        addi      r3,r3,8
+        b         .LFillCharVerySmall
+.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;
+{$endif FPC_SYSTEM_HAS_FILLCHAR}
+
+
+{$ifndef FPC_SYSTEM_HAS_FILLDWORD}
+{$define FPC_SYSTEM_HAS_FILLDWORD}
+procedure filldword(var x;count : longint;value : dword);
+assembler; nostackframe;
+asm
+{       registers:
+        r3              x
+        r4              count
+        r5              value
+}
+                cmpwi   cr0,r4,0
+                mtctr   r4
+                subi    r3,r3,4
+                ble    .LFillDWordEnd    //if count<=0 Then Exit
+.LFillDWordLoop:
+                stwu    r5,4(r3)
+                bdnz    .LFillDWordLoop
+.LFillDWordEnd:
+end;
+{$endif FPC_SYSTEM_HAS_FILLDWORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_INDEXBYTE}
+{$define FPC_SYSTEM_HAS_INDEXBYTE}
+function IndexByte(const buf;len:longint;b:byte):longint; assembler; nostackframe;
+{ 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
+                ble     .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;
+{$endif FPC_SYSTEM_HAS_INDEXBYTE}
+
+
+{$ifndef FPC_SYSTEM_HAS_INDEXWORD}
+{$define FPC_SYSTEM_HAS_INDEXWORD}
+function IndexWord(const buf;len:longint;b:word):longint; assembler; nostackframe;
+{ 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
+                ble     .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
+                srawi   r3,r3,1
+.LIndexWordDone:
+end;
+{$endif FPC_SYSTEM_HAS_INDEXWORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_INDEXDWORD}
+{$define FPC_SYSTEM_HAS_INDEXDWORD}
+function IndexDWord(const buf;len:longint;b:DWord):longint; assembler; nostackframe;
+{ 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
+                ble     .LIndexDWordDone
+.LIndexDWordLoop:
+                lwzu    r9,4(r10)
+                cmplw   r9,r5
+                bdnzf   cr0*4+eq, .LIndexDWordLoop
+                { r3 still contains -1 here }
+                bne     .LIndexDWordDone
+                sub     r3,r10,r0
+                srawi   r3,r3,2
+.LIndexDWordDone:
+end;
+{$endif FPC_SYSTEM_HAS_INDEXDWORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_COMPAREBYTE}
+{$define FPC_SYSTEM_HAS_COMPAREBYTE}
+function CompareByte(const buf1,buf2;len:longint):longint; assembler; nostackframe;
+{ 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
+        ble     .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;
+{$endif FPC_SYSTEM_HAS_COMPAREBYTE}
+
+
+{$ifndef FPC_SYSTEM_HAS_COMPAREWORD}
+{$define FPC_SYSTEM_HAS_COMPAREWORD}
+function CompareWord(const buf1,buf2;len:longint):longint; assembler; nostackframe;
+{ 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
+        ble     .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;
+{$endif FPC_SYSTEM_HAS_COMPAREWORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_COMPAREDWORD}
+{$define FPC_SYSTEM_HAS_COMPAREDWORD}
+function CompareDWord(const buf1,buf2;len:longint):longint; assembler; nostackframe;
+{ 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
+        ble     .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;
+{$endif FPC_SYSTEM_HAS_COMPAREDWORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_INDEXCHAR0}
+{$define FPC_SYSTEM_HAS_INDEXCHAR0}
+function IndexChar0(const buf;len:longint;b:Char):longint; assembler; nostackframe;
+{ 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
+        subi    r0,r3,1
+        { assume not found }
+        li      r3,-1
+        { if yes, do nothing }
+        ble     .LIndexChar0Done
+.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;
+{$endif FPC_SYSTEM_HAS_INDEXCHAR0}
+
+
+{****************************************************************************
+                                 String
+****************************************************************************}
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
+{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
+function fpc_shortstr_to_shortstr(len:longint; const sstr: shortstring): shortstring; [public,alias: 'FPC_SHORTSTR_TO_SHORTSTR']; compilerproc;
+assembler; nostackframe;
+{ 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  0,r3
+
+        { put min(length(sstr),len) in r4 }
+        subfc   r7,r10,r4     { r0 := r4 - r10                               }
+        subfe   r4,r4,r4      { if r3 >= r4 then r3' := 0 else r3' := -1     }
+        and     r7,r7,r4      { if r3 >= r4 then r3' := 0 else r3' := r3-r10 }
+        add     r4,r10,r7     { 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
+.LShortStrCopyDone:
+end;
+
+
+procedure fpc_shortstr_assign(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_ASSIGN'];
+assembler; nostackframe;
+{ 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  0,r5
+
+        { put min(length(sstr),len) in r3 }
+        subc    r0,r3,r10    { r0 := r3 - r10                               }
+        subfe   r3,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
+.LShortStrCopyDone2:
+end;
+{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
+
+(*
+{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
+{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
+
+function fpc_shortstr_concat(const s1, s2: shortstring): shortstring; compilerproc; [public, alias: 'FPC_SHORTSTR_CONCAT'];
+{ expects that (r3) contains a pointer to the result r4 to s1, r5 to s2 }
+assembler;
+asm
+      { load length s1 }
+      lbz     r6, 0(r4)
+      { load length s2 }
+      lbz     r10, 0(r5)
+      { length 0 for s1? }
+      cmplwi  cr7,r6,0
+      { length 255 for s1? }
+      subfic. r7,r6,255
+      { length 0 for s2? }
+      cmplwi  cr1,r10,0
+      { calculate min(length(s2),255-length(s1)) }
+      subc    r8,r7,r10    { r8 := r7 - r10                                }
+      cror    4*6+2,4*1+2,4*7+2
+      subfe   r7,r7,r7     { if r7 >= r10 then r7' := 0 else r7' := -1     }
+      mtctr   r6
+      and     r7,r8,r7     { if r7 >= r10 then r7' := 0 else r7' := r7-r10 }
+      add     r7,r7,r10    { if r7 >= r10 then r7' := r10 else r7' := r7   }
+
+      mr      r9,r3
+
+      { calculate length of final string }
+      add     r8,r7,r6
+      stb     r8,0(r3)
+      beq     cr7, .Lcopys1loopDone
+    .Lcopys1loop:
+      lbzu    r0,1(r4)
+      stbu    r0,1(r9)
+      bdnz    .Lcopys1loop
+    .Lcopys1loopDone:
+      mtctr   r7
+      beq     cr6, .LconcatDone
+    .Lcopys2loop:
+      lbzu    r0,1(r5)
+      stbu    r0,1(r9)
+      bdnz    .Lcopys2loop
+end;
+{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
+*)
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR}
+{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR}
+
+procedure fpc_shortstr_append_shortstr(var s1: shortstring; const s2: shortstring); compilerproc;
+{ expects that results (r3) contains a pointer to the current string s1, r4 }
+{ high(s1) and (r5) a pointer to the one that has to be concatenated        }
+assembler; nostackframe;
+asm
+      { load length s1 }
+      lbz     r6, 0(r3)
+      { load length s2 }
+      lbz     r10, 0(r5)
+      { length 0? }
+      cmplw   cr1,r6,r4
+      cmplwi  r10,0
+
+      { calculate min(length(s2),high(result)-length(result)) }
+      sub     r9,r4,r6
+      subc    r8,r9,r10    { r8 := r9 - r10                                }
+      cror    4*7+2,4*0+2,4*1+2
+      subfe   r9,r9,r9     { if r9 >= r10 then r9' := 0 else r9' := -1     }
+      and     r9,r8,r9     { if r9 >= r10 then r9' := 0 else r9' := r9-r10 }
+      add     r9,r9,r10    { if r9 >= r10 then r9' := r10 else r9' := r9   }
+
+      { calculate new length }
+      add     r10,r6,r9
+      { load value to copy in ctr }
+      mtctr   r9
+      { store new length }
+      stb     r10,0(r3)
+      { go to last current character of result }
+      add     r3,r6,r3
+
+      { if nothing to do, exit }
+      beq    cr7, .LShortStrAppendDone
+      { and concatenate }
+.LShortStrAppendLoop:
+      lbzu    r10,1(r5)
+      stbu    r10,1(r3)
+      bdnz    .LShortStrAppendLoop
+.LShortStrAppendDone:
+end;
+{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR}
+
+(*
+{$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)) }
+      subfc    r7,r10,r9    { r0 := r9 - r10                               }
+      subfe    r9,r9,r9     { if r9 >= r10 then r9' := 0 else r9' := -1    }
+      and      r7,r7,r9     { if r9 >= r10 then r9' := 0 else r9' := r9-r8 }
+      add      r9,r10,r7    { if r9 >= r10 then r9' := r10 else r9' := r9  }
+
+      { first compare dwords (length/4) }
+      srwi.   r5,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
+      { so we can load r3 with 0, in case the strings both have length 0 }
+      mr      r8,r3
+      li      r3, 0
+      { length div 4 in ctr for loop }
+      mtctr   r5
+      { 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,r8,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
+      mtctr   r9
+LShortStrCompare1Loop:
+      lbzu    r3,1(r4)
+      lbzu    r10,1(r8)
+      sub.    r3,r3,r10
+      bdnzt   cr0+eq,LShortStrCompare1Loop
+      bne     LShortStrCompareDone
+LShortStrCompareLen:
+      { also return result in flags, maybe we can use this in the CG }
+      mr.     r3,r3
+LShortStrCompareDone:
+end;
+*)
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
+{$define FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
+function fpc_pchar_to_shortstr(p:pchar):shortstring;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; compilerproc;
+assembler; nostackframe;
+{$include strpas.inc}
+{$endif FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
+{$define FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
+function fpc_pchar_length(p:pchar):longint;assembler;[public,alias:'FPC_PCHAR_LENGTH']; compilerproc; nostackframe;
+{$include strlen.inc}
+{$endif FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
+
+
+{$define FPC_SYSTEM_HAS_GET_FRAME}
+function get_frame:pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
+asm
+  { all abi's I know use r1 as stack pointer }
+  mr r3, r1
+end;
+
+{NOTE: On MACOS, 68000 code might call powerpc code, through the MixedMode manager,
+(even in the OS in system 9). The pointer to the switching stack frame is then
+indicated by the first bit set to 1. This is checked below.}
+
+{Both routines below assumes that framebp is a valid framepointer or nil.}
+
+{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
+function get_caller_addr(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
+asm
+   cmplwi  r3,0
+   beq     .Lcaller_addr_invalid
+   lwz r3,0(r3)
+   cmplwi  r3,0
+   beq     .Lcaller_addr_invalid
+{$ifdef MACOS}
+   rlwinm  r4,r3,0,31,31
+   cmpwi   r4,0
+   bne  cr0,.Lcaller_addr_invalid
+{$endif MACOS}
+{$ifdef FPC_ABI_AIX}
+   lwz r3,8(r3)
+{$else FPC_ABI_AIX}
+   lwz r3,4(r3)
+{$endif FPC_ABI_AIX}
+   blr
+.Lcaller_addr_invalid:
+   li r3,0
+end;
+
+
+{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
+function get_caller_frame(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
+asm
+    cmplwi  r3,0
+    beq     .Lcaller_frame_invalid
+    lwz  r3,0(r3)
+{$ifdef MACOS}
+    rlwinm      r4,r3,0,31,31
+    cmpwi       r4,0
+    bne cr0,.Lcaller_frame_invalid
+{$endif MACOS}
+    blr
+.Lcaller_frame_invalid:
+    li r3,0
+end;
+
+{$define FPC_SYSTEM_HAS_ABS_LONGINT}
+function abs(l:longint):longint; assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
+asm
+        srawi   r0,r3,31
+        add     r3,r0,r3
+        xor     r3,r3,r0
+end;
+
+
+{****************************************************************************
+                                 Math
+****************************************************************************}
+
+{$define FPC_SYSTEM_HAS_ODD_LONGINT}
+function odd(l:longint):boolean;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
+asm
+        rlwinm  r3,r3,0,31,31
+end;
+
+
+{$define FPC_SYSTEM_HAS_SQR_LONGINT}
+function sqr(l:longint):longint;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
+asm
+        mullw   r3,r3,r3
+end;
+
+
+{$define FPC_SYSTEM_HAS_SPTR}
+Function Sptr : Pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
+asm
+        mr    r3,r1
+end;
+
+
+{****************************************************************************
+                                 Str()
+****************************************************************************}
+
+{ int_str: generic implementation is used for now }
+
+
+{****************************************************************************
+                             Multithreading
+****************************************************************************}
+
+{ do a thread save inc/dec }
+
+{$define FPC_SYSTEM_HAS_DECLOCKED_LONGINT}
+function declocked(var l : longint) : boolean;assembler;nostackframe;
+{ input:  address of l in r3                                      }
+{ output: boolean indicating whether l is zero after decrementing }
+asm
+.LDecLockedLoop:
+    lwarx   r10,0,r3
+    subi    r10,r10,1
+    stwcx.  r10,0,r3
+    bne-    .LDecLockedLoop
+    cntlzw  r3,r10
+    srwi    r3,r3,5
+end;
+
+{$define FPC_SYSTEM_HAS_INCLOCKED_LONGINT}
+procedure inclocked(var l : longint);assembler;nostackframe;
+asm
+.LIncLockedLoop:
+    lwarx   r10,0,r3
+    addi    r10,r10,1
+    stwcx.  r10,0,r3
+    bne-    .LIncLockedLoop
+end;
+
+
+{$IFDEF MORPHOS}
+{ this is only required for MorphOS }
+{$define FPC_SYSTEM_HAS_SYSRESETFPU}
+procedure SysResetFPU;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
+var tmp: array[0..1] of dword;
+asm
+   { setting fpu to round to nearest mode }
+   li r3,0
+   stw r3,8(r1)
+   stw r3,12(r1)  
+   lfd f1,8(r1)
+   mtfsf 7,f1    
+end;
+{$ENDIF}