* some cg reorganisation

  * some PPC updates

compiler/aopt.pas

@@ -0,0 +1,276 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Jonas Maebe, member of the Free Pascal
+    Development Team
+
+    This unit contains the interface routines between the code generator
+    and the optimizer.
+
+    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 aopt;
+
+Interface
+
+Uses Aasm, cobjects, aoptobj, aoptcpud, aoptcpub {aoptcs, aoptpeep} ;
+
+Type
+  PAsmOptimizer = ^TAsmOptimizer;
+  TAsmOptimizer = Object(TAoptObj)
+
+    { _AsmL is the PAasmOutpout list that has to be optimized }
+    Constructor Init(_AsmL: PAasmOutput);
+
+    { call the necessary optimizer procedures }
+    Procedure Optimize;
+    Destructor Done;
+
+    private
+
+    Function FindLoHiLabels: Pai;
+    Procedure BuildLabelTableAndFixRegAlloc;
+
+  End;
+
+procedure Optimize(AsmL:Paasmoutput);
+
+
+Implementation
+
+uses cpuinfo, globtype, globals, tainst;
+
+Constructor TAsmOptimizer.Init(_AsmL: PAasmOutput);
+Begin
+  AsmL := _AsmL;
+{setup labeltable, always necessary}
+  New(LabelInfo);
+  LabelInfo^.LowLabel := High(AWord);
+  LabelInfo^.HighLabel := 0;
+  LabelInfo^.LabelDif := 0;
+End;
+
+Function TAsmOptimizer.FindLoHiLabels: Pai;
+{ Walks through the paasmlist to find the lowest and highest label number.  }
+{ Returns the last Pai object of the current block                          }
+Var LabelFound: Boolean;
+    P: Pai;
+Begin
+  LabelFound := False;
+  P := BlockStart;
+  With LabelInfo^ Do
+    Begin
+      While Assigned(P) And
+            ((P^.typ <> Ait_Marker) Or
+             (Pai_Marker(P)^.Kind <> AsmBlockStart)) Do
+        Begin
+          If (Pai(p)^.typ = ait_label) Then
+            If (Pai_Label(p)^.l^.is_used) Then
+              Begin
+                LabelFound := True;
+                If (Pai_Label(p)^.l^.labelnr < LowLabel) Then
+                  LowLabel := Pai_Label(p)^.l^.labelnr;
+                If (Pai_Label(p)^.l^.labelnr > HighLabel) Then
+                  HighLabel := Pai_Label(p)^.l^.labelnr
+              End;
+          GetNextInstruction(p, p)
+        End;
+      FindLoHiLabels := p;
+      If LabelFound
+        Then LabelDif := HighLabel-LowLabel+1
+        Else LabelDif := 0
+    End
+End;
+
+Procedure TAsmOptimizer.BuildLabelTableAndFixRegAlloc;
+{ Builds a table with the locations of the labels in the paasmoutput.       }
+{ Also fixes some RegDeallocs like "# %eax released; push (%eax)"           }
+Var p, hp1, hp2: Pai;
+    UsedRegs: TRegSet;
+Begin
+  UsedRegs := [];
+  With LabelInfo^ Do
+    If (LabelDif <> 0) Then
+      Begin
+        GetMem(LabelTable, LabelDif*SizeOf(TLabelTableItem));
+        FillChar(LabelTable^, LabelDif*SizeOf(TLabelTableItem), 0);
+        p := BlockStart;
+        While (P <> BlockEnd) Do
+          Begin
+            Case p^.typ Of
+              ait_Label:
+                If Pai_Label(p)^.l^.is_used Then
+                  LabelTable^[Pai_Label(p)^.l^.labelnr-LowLabel].PaiObj := p;
+              ait_regAlloc:
+                begin
+                  if PairegAlloc(p)^.Allocation then
+                    Begin
+                      If Not(PaiRegAlloc(p)^.Reg in UsedRegs) Then
+                        UsedRegs := UsedRegs + [PaiRegAlloc(p)^.Reg]
+                      Else
+                        Begin
+                          hp1 := p;
+                          hp2 := nil;
+                          While GetLastInstruction(hp1, hp1) And
+                                Not(RegInInstruction(PaiRegAlloc(p)^.Reg, hp1)) Do
+                            hp2 := hp1;
+                          If hp2 <> nil Then
+                            Begin
+                              hp1 := New(PaiRegAlloc, DeAlloc(PaiRegAlloc(p)^.Reg));
+                              InsertLLItem(Pai(hp2^.previous), hp2, hp1);
+                            End;
+                        End;
+                    End
+                  else
+                    Begin
+                      UsedRegs := UsedRegs - [PaiRegAlloc(p)^.Reg];
+                      hp1 := p;
+                      hp2 := nil;
+                      While Not(FindRegAlloc(PaiRegAlloc(p)^.Reg, Pai(hp1^.Next))) And
+                            GetNextInstruction(hp1, hp1) And
+                            RegInInstruction(PaiRegAlloc(p)^.Reg, hp1) Do
+                        hp2 := hp1;
+                      If hp2 <> nil Then
+                        Begin
+                          hp1 := Pai(p^.previous);
+                          AsmL^.Remove(p);
+                          InsertLLItem(hp2, Pai(hp2^.Next), p);
+                          p := hp1;
+                        End
+                    End
+                End
+            End
+          End;
+        P := Pai(p^.Next);
+        While Assigned(p) And
+              (p^.typ in (SkipInstr - [ait_regalloc])) Do
+          P := Pai(P^.Next)
+      End
+End;
+
+
+
+Procedure TAsmOptimizer.Optimize;
+Var HP: Pai;
+    DFA: PAOptDFACpu;
+Begin
+  BlockStart := Pai(AsmL^.First);
+  While Assigned(BlockStart) Do
+    Begin
+      { Initialize BlockEnd and the LabelInfo (low and high label) }
+      BlockEnd := FindLoHiLabels;
+      { initialize the LabelInfo (labeltable) and fix the regalloc info }
+      BuildLabelTableAndFixRegAlloc;
+      { peephole optimizations, twice because you can't do them all in one }
+      { pass                                                               }
+{      PeepHoleOptPass1;
+      PeepHoleOptPass1;}
+      If (cs_slowoptimize in aktglobalswitches) Then
+        Begin
+          New(DFA,Init(AsmL,BlockStart,BlockEnd,LabelInfo));
+          { data flow analyzer }
+          DFA^.DoDFA;
+          { common subexpression elimination }
+{          CSE;}
+        End;
+      { more peephole optimizations }
+{      PeepHoleOptPass2;}
+      {dispose labeltabel}
+      If Assigned(LabelInfo^.LabelTable) Then
+        Begin
+          Dispose(LabelInfo^.LabelTable);
+          LabelInfo := Nil
+        End;
+      { continue where we left off, BlockEnd is either the start of an }
+      { assembler block or nil}
+      BlockStart := BlockEnd;
+      While Assigned(BlockStart) And
+            (BlockStart^.typ = ait_Marker) And
+            (Pai_Marker(BlockStart)^.Kind = AsmBlockStart) Do
+        Begin
+         { we stopped at an assembler block, so skip it }
+          While GetNextInstruction(BlockStart, BlockStart) And
+                ((BlockStart^.Typ <> Ait_Marker) Or
+                 (Pai_Marker(Blockstart)^.Kind <> AsmBlockEnd)) Do;
+         { blockstart now contains a pai_marker(asmblockend) }
+          If Not(GetNextInstruction(BlockStart, HP) And
+                 ((HP^.typ <> ait_Marker) Or
+                  (Pai_Marker(HP)^.Kind <> AsmBlockStart)
+                 )
+                ) Then
+           {skip the next assembler block }
+           BlockStart := HP;
+         { otherwise there is no assembler block anymore after the current }
+         { one, so optimize the next block of "normal" instructions        }
+        End
+    End;
+End;
+
+Destructor TAsmOptimizer.Done;
+Begin
+  Dispose(LabelInfo)
+End;
+
+
+procedure Optimize(AsmL:Paasmoutput);
+var
+  p : PAsmOptimizer;
+begin
+  new(p,Init(AsmL));
+  p^.Optimize;
+  dispose(p,Done);
+end;
+
+
+End.
+
+{Virtual methods, most have to be overridden by processor dependent methods}
+
+{
+ $Log$
+ Revision 1.1  2001-08-26 13:36:35  florian
+   * some cg reorganisation
+   * some PPC updates
+
+ Revision 1.1  2000/07/13 06:30:07  michael
+ + Initial import
+
+ Revision 1.5  2000/01/07 01:14:51  peter
+   * updated copyright to 2000
+
+ Revision 1.4  1999/11/09 22:57:08  peter
+   * compiles again both i386,alpha both with optimizer
+
+ Revision 1.3  1999/08/18 14:32:20  jonas
+   + compilable!
+   + dataflow analyzer finished
+   + start of CSE units
+   + aoptbase which contains a base object for all optimizer objects
+   * some constants and type definitions moved around to avoid circular
+     dependencies
+   * moved some methods from base objects to specialized objects because
+     they're not used anywhere else
+
+ Revision 1.2  1999/08/09 14:07:22  jonas
+ commit.msg
+
+ Revision 1.1  1999/08/08 13:24:50  jonas
+   + added copyright header/GNU license info
+   * made the assembler optimizer almost completely OOP
+   * some code style clean up and extra comments
+   * moved from the new/aopt to the /new and /new/i386 dirs
+
+}

compiler/aoptbase.pas

@@ -0,0 +1,295 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Jonas Maebe, member of the Free Pascal
+    Development Team
+
+    This unit contains the base of all optimizer related objects
+
+    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 aoptbase;
+
+Interface
+
+uses aasm, cpuasm,cpubase;
+
+{ the number of tai objects processed by an optimizer object since the last }
+{ time a register was modified                                              }
+Type TInstrSinceLastMod = Array[LoGPReg..HiGPReg] of byte;
+
+{ the TAopBase object implements the basic methods that most other }
+{ assembler optimizer objects require                              }
+Type
+  TAoptBase = Object
+    { processor independent methods }
+
+    constructor init;
+    destructor done;
+    { returns true if register Reg is used by instruction p1 }
+    Function RegInInstruction(Reg: TRegister; p1: tai): Boolean;
+    { returns true if register Reg occurs in operand op }
+    Function RegInOp(Reg: TRegister; const op: toper): Boolean;
+    { returns true if register Reg is used in the reference Ref }
+    Function RegInRef(Reg: TRegister; Const Ref: TReference): Boolean;
+
+    { returns true if the references are completely equal }
+    {Function RefsEqual(Const R1, R2: TReference): Boolean;}
+
+    { gets the next tai object after current that contains info relevant }
+    { to the optimizer in p1. If there is none, it returns false and     }
+    { sets p1 to nil                                                     }
+    Function GetNextInstruction(Current: tai; Var Next: tai): Boolean;
+    { gets the previous tai object after current that contains info  }
+    { relevant to the optimizer in last. If there is none, it retuns }
+    { false and sets last to nil                                     }
+    Function GetLastInstruction(Current: tai; Var Last: tai): Boolean;
+
+
+    { processor dependent methods }
+
+    { returns the maximum width component of Reg. Only has to be }
+    { overridden for the 80x86 (afaik)                           }
+    Function RegMaxSize(Reg: TRegister): TRegister; Virtual;
+    { returns true if Reg1 and Reg2 are of the samae width. Only has to }
+    { overridden for the 80x86 (afaik)                                  }
+    Function RegsSameSize(Reg1, Reg2: TRegister): Boolean; Virtual;
+    { returns whether P is a load instruction (load contents from a }
+    { memory location or (register) variable into a register)       }
+    Function IsLoadMemReg(p: tai): Boolean; Virtual;
+    { returns whether P is a load constant instruction (load a constant }
+    { into a register)                                                  }
+    Function IsLoadConstReg(p: tai): Boolean; Virtual;
+    { returns whether P is a store instruction (store contents from a }
+    { register to a memory location or to a (register) variable)      }
+    Function IsStoreRegMem(p: tai): Boolean; Virtual;
+
+    { create a paicpu Object that loads the contents of reg1 into reg2 }
+    Function a_load_reg_reg(reg1, reg2: TRegister): taicpu; Virtual;
+
+end;
+
+Function RefsEqual(Const R1, R2: TReference): Boolean;
+
+
+Implementation
+
+uses globals, aoptcpub, cpuinfo;
+
+Function RefsEqual(Const R1, R2: TReference): Boolean;
+Begin
+  If R1.is_immediate Then
+    RefsEqual := R2.is_immediate and (R1.Offset = R2.Offset)
+  Else
+    RefsEqual := (R1.Offset+R1.OffsetFixup = R2.Offset+R2.OffsetFixup)
+                 And (R1.Base = R2.Base)
+{$ifdef RefsHaveindex}
+                 And (R1.Index = R2.Index)
+{$endif RefsHaveindex}
+{$ifdef RefsHaveScale}
+                 And (R1.ScaleFactor = R2.ScaleFactor)
+{$endif RefsHaveScale}
+                 And (R1.Symbol = R2.Symbol)
+{$ifdef RefsHaveSegment}
+                 And (R1.Segment = R2.Segment)
+{$endif RefsHaveSegment}
+End;
+
+
+constructor taoptbase.init;
+begin
+end;
+
+destructor taoptbase.done;
+begin
+end;
+
+Function TAOptBase.RegInInstruction(Reg: TRegister; p1: tai): Boolean;
+Var Count: AWord;
+    TmpResult: Boolean;
+Begin
+  TmpResult := False;
+  Count := 0;
+  If (p1.typ = ait_instruction) Then
+    Repeat
+      TmpResult := RegInOp(Reg, PInstr(p1)^.oper[Count]);
+      Inc(Count)
+    Until (Count = MaxOps) or TmpResult;
+  RegInInstruction := TmpResult
+End;
+
+
+Function TAOptBase.RegInOp(Reg: TRegister; const op: toper): Boolean;
+Begin
+  Case op.typ Of
+    Top_Reg: RegInOp := Reg = op.reg;
+    Top_Ref: RegInOp := RegInRef(Reg, op.ref^)
+    Else RegInOp := False
+  End
+End;
+
+
+Function TAOptBase.RegInRef(Reg: TRegister; Const Ref: TReference): Boolean;
+Begin
+  Reg := RegMaxSize(Reg);
+  RegInRef := (Ref.Base = Reg)
+{$ifdef RefsHaveIndexReg}
+  Or (Ref.Index = Reg)
+{$endif RefsHaveIndexReg}
+End;
+
+Function TAOptBase.GetNextInstruction(Current: tai; Var Next: tai): Boolean;
+Begin
+  Repeat
+    Current := tai(Current.Next);
+    While Assigned(Current) And
+          ((Current.typ In SkipInstr) or
+           ((Current.typ = ait_label) And
+            Not(Tai_Label(Current).l.is_used))) Do
+      Current := tai(Current.Next);
+    If Assigned(Current) And
+       (Current.typ = ait_Marker) And
+       (Tai_Marker(Current).Kind = NoPropInfoStart) Then
+      Begin
+        While Assigned(Current) And
+              ((Current.typ <> ait_Marker) Or
+               (Tai_Marker(Current).Kind <> NoPropInfoEnd)) Do
+          Current := Tai(Current.Next);
+      End;
+  Until Not(Assigned(Current)) Or
+        (Current.typ <> ait_Marker) Or
+        (Tai_Marker(Current).Kind <> NoPropInfoEnd);
+  Next := Current;
+  If Assigned(Current) And
+     Not((Current.typ In SkipInstr) or
+         ((Current.typ = ait_label) And
+          Not(Tai_Label(Current).l.is_used)))
+    Then GetNextInstruction := True
+    Else
+      Begin
+        Next := Nil;
+        GetNextInstruction := False;
+      End;
+End;
+
+Function TAOptBase.GetLastInstruction(Current: tai; Var Last: tai): Boolean;
+Begin
+  Repeat
+    Current := Tai(Current.previous);
+    While Assigned(Current) And
+          (((Current.typ = ait_Marker) And
+            Not(Tai_Marker(Current).Kind in [AsmBlockEnd,NoPropInfoEnd])) or
+           (Current.typ In SkipInstr) or
+           ((Current.typ = ait_label) And
+             Not(Tai_Label(Current).l.is_used))) Do
+      Current := Tai(Current.previous);
+    If Assigned(Current) And
+       (Current.typ = ait_Marker) And
+       (Tai_Marker(Current).Kind = NoPropInfoEnd) Then
+      Begin
+        While Assigned(Current) And
+              ((Current.typ <> ait_Marker) Or
+               (Tai_Marker(Current).Kind <> NoPropInfoStart)) Do
+          Current := Tai(Current.previous);
+      End;
+  Until Not(Assigned(Current)) Or
+        (Current.typ <> ait_Marker) Or
+        (Tai_Marker(Current).Kind <> NoPropInfoStart);
+  If Not(Assigned(Current)) or
+     (Current.typ In SkipInstr) or
+     ((Current.typ = ait_label) And
+      Not(Tai_Label(Current).l.is_used)) or
+     ((Current.typ = ait_Marker) And
+      (Tai_Marker(Current).Kind = AsmBlockEnd))
+    Then
+      Begin
+        Last := Nil;
+        GetLastInstruction := False
+      End
+    Else
+      Begin
+        Last := Current;
+        GetLastInstruction := True;
+      End;
+End;
+
+
+{ ******************* Processor dependent stuff *************************** }
+
+Function TAOptBase.RegMaxSize(Reg: TRegister): TRegister;
+Begin
+  RegMaxSize := Reg
+End;
+
+Function TAOptBase.RegsSameSize(Reg1, Reg2: TRegister): Boolean;
+Begin
+  RegsSameSize := True
+End;
+
+Function TAOptBase.IsLoadMemReg(p: tai): Boolean;
+Begin
+  Abstract
+End;
+
+Function TAOptBase.IsLoadConstReg(p: tai): Boolean;
+Begin
+  Abstract
+End;
+
+Function TAOptBase.IsStoreRegMem(p: tai): Boolean;
+Begin
+  Abstract
+End;
+
+Function TAoptBase.a_load_reg_reg(reg1, reg2: TRegister): taicpu;
+Begin
+  Abstract
+End;
+
+End.
+
+{
+  $Log$
+  Revision 1.1  2001-08-26 13:36:35  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.1  2000/07/13 06:30:07  michael
+  + Initial import
+
+  Revision 1.5  2000/01/07 01:14:51  peter
+    * updated copyright to 2000
+
+  Revision 1.4  1999/11/09 22:57:08  peter
+    * compiles again both i386,alpha both with optimizer
+
+  Revision 1.3  1999/09/08 15:01:31  jonas
+    * some small changes so the noew optimizer is again compilable
+
+  Revision 1.2  1999/08/23 14:41:12  jonas
+    + checksequence (processor independent)\n  + processor independent part of docse
+
+  Revision 1.1  1999/08/18 14:32:21  jonas
+    + compilable!
+    + dataflow analyzer finished
+    + start of CSE units
+    + aoptbase which contains a base object for all optimizer objects
+    * some constants and type definitions moved around to avoid circular
+      dependencies
+    * moved some methods from base objects to specialized objects because
+      they're not used anywhere else
+
+}

compiler/aoptcs.pas

@@ -0,0 +1,885 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Jonas Maebe, member of the Free Pascal
+    Development Team
+
+    This unit contains the common subexpression elimination object of the
+    assembler optimizer.
+
+    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 aoptcs;
+
+interface
+
+uses aasm, aoptcpu, aoptobj;
+
+{ ************************************************************************* }
+{ info about the equivalence of registers when comparing two code sequences }
+{ ************************************************************************* }
+
+  TRegInfo = Object(TAoptBaseCpu)
+    { registers encountered in the new and old sequence }
+    NewRegsEncountered, OldRegsEncountered,
+    { registers which only have been loaded for use as base or index in a }
+    { reference later on                                                  }
+    RegsLoadedForRef: TRegSet;
+    { to which register in the old sequence corresponds every register in }
+    { the new sequence                                                    }
+    New2OldReg: TRegArray;
+
+    Constructor init;
+    { clear all information store in the object }
+    Procedure Clear;
+    { the contents of OldReg in the old sequence are now being loaded into }
+    { NewReg in the new sequence                                           }
+    Procedure AddReg(OldReg, NewReg: TRegister); Virtual;
+    { the contents of OldOp in the old sequence are now being loaded into }
+    { NewOp in the new sequence. It is assumed that OldOp and NewOp are   }
+    { equivalent                                                          }
+    Procedure AddOp(const OldOp, NewOp:Toper);
+    { check if a register in the old sequence (OldReg) can be equivalent to }
+    { a register in the new sequence (NewReg) if the operation OpAct is     }
+    { performed on it. The RegInfo is updated (not necessary to call AddReg }
+    { afterwards)                                                           }
+    Function RegsEquivalent(OldReg, NewReg: TRegister; OpAct: TopAction):
+      Boolean;
+    { check if a reference in the old sequence (OldRef) can be equivalent   }
+    { to a reference in the new sequence (NewRef) if the operation OpAct is }
+    { performed on it. The RegInfo is updated (not necessary to call AddOp  }
+    { afterwards)                                                           }
+    Function RefsEquivalent(Const OldRef, NewRef: TReference; OpAct:
+      TOpAction): Boolean;
+    { check if an operand in the old sequence (OldOp) can be equivalent to }
+    { an operand in the new sequence (NewOp) if the operation OpAct is     }
+    { performed on it. The RegInfo is updated (not necessary to call AddOp }
+    { afterwards)                                                          }
+    Function OpsEquivalent(const OldOp, NewOp: toper; OpAct: TopAction):
+      Boolean;
+    { check if an instruction in the old sequence (OldP) can be equivalent  }
+    { to an instruction in the new sequence (Newp). The RegInfo is updated  }
+    Function InstructionsEquivalent(OldP, NewP: Pai): Boolean;
+  End;
+
+
+{ ************************************************************************* }
+{ *************** The common subexpression elimination object ************* }
+{ ************************************************************************* }
+
+Type TAoptCSE = Object(TAoptObj)
+       { returns true if the instruction p1 modifies the register Reg }
+       Function RegModifiedByInstruction(Reg: TRegister; p1: Pai): Boolean;
+     End;
+
+Implementation
+
+{ ************************************************************************* }
+{ ******************************* TReginfo ******************************** }
+{ ************************************************************************* }
+
+Constructor TRegInfo.Init;
+Begin
+  Clear;
+End;
+
+Procedure TRegInfo.Clear;
+Begin
+  RegsLoadedForRef   := [];
+  NewRegsEncountered := [ProcInfo.FramePointer, stack_pointer];
+  OldRegsEncountered := [ProcInfo.FramePointer, stack_pointer];
+  New2OldReg[ProcInfo.FramePointer] := ProcInfo.FramePointer;
+  New2OldReg[stack_pointer] := stack_pointer;
+End;
+
+Procedure TRegInfo.AddReg(OldReg, NewReg: TRegister);
+{ updates the ???RegsEncountered and ???2???Reg fields of RegInfo. Assumes  }
+{ that OldReg and NewReg have the same size (has to be chcked in advance    }
+{ with RegsSameSize) and that neither equals R_NO                           }
+{ has to be overridden for architectures like the 80x86 when not all GP     }
+{ regs are of the same size                                                 }
+Begin
+  NewRegsEncountered := NewRegsEncountered + [NewReg];
+  OldRegsEncountered := OldRegsEncountered + [OldReg];
+  New2OldReg[NewReg] := OldReg;
+End;
+
+Procedure TRegInfo.AddOp(const OldOp, NewOp:Toper);
+Begin
+  Case OldOp.typ Of
+    Top_Reg:
+      If (OldOp.reg <> R_NO) Then
+        AddReg(OldOp.reg, NewOp.reg);
+    Top_Ref:
+      Begin
+        If OldOp.ref^.base <> R_NO Then
+          AddReg(OldOp.ref^.base, NewOp.ref^.base);
+{$ifdef RefsHaveIndexReg}
+        If OldOp.ref^.index <> R_NO Then
+          AddReg(OldOp.ref^.index, NewOp.ref^.index);
+{$endif RefsHaveIndexReg}
+      End;
+  End;
+End;
+
+Function TRegInfo.RegsEquivalent(OldReg, NewReg: TRegister;
+           OPAct: TOpAction): Boolean;
+Begin
+  If Not((OldReg = R_NO) Or (NewReg = R_NO)) Then
+    If RegsSameSize(OldReg, NewReg) Then
+{ here we always check for the 32 bit component, because it is possible    }
+{ that the 8 bit component has not been set, event though NewReg already   }
+{ has been processed. This happens if it has been compared with a register }
+{ that doesn't have an 8 bit component (such as EDI). In that case the 8   }
+{ bit component is still set to R_NO and the comparison in the Else-part   }
+{ will fail                                                                }
+      If (RegMaxSize(OldReg) in OldRegsEncountered) Then
+        If (RegMaxSize(NewReg) in NewRegsEncountered) Then
+          RegsEquivalent := (OldReg = New2OldReg[NewReg])
+{ If we haven't encountered the new register yet, but we have encountered }
+{ the old one already, the new one can only be correct if it's being      }
+{ written to (and consequently the old one is also being written to),     }
+{ otherwise                                                               }
+{                                                                         }
+{  movl -8(%ebp), %eax        and         movl -8(%ebp), %eax             }
+{  movl (%eax), %eax                      movl (%edx), %edx               }
+{                                                                         }
+{  are considered equivalent                                              }
+        Else
+          If (OpAct = OpAct_Write) Then
+            Begin
+              AddReg(OldReg, NewReg);
+              RegsEquivalent := True
+            End
+          Else Regsequivalent := False
+      Else
+        If Not(RegMaxSize(NewReg) in NewRegsEncountered) Then
+          Begin
+            AddReg(OldReg, NewReg);
+            RegsEquivalent := True
+          End
+        Else RegsEquivalent := False
+    Else RegsEquivalent := False
+  Else RegsEquivalent := OldReg = NewReg
+End;
+
+Function TRegInfo.RefsEquivalent(Const OldRef, NewRef: TReference;
+           OpAct: TOpAction): Boolean;
+Begin
+  If OldRef.is_immediate Then
+    RefsEquivalent := NewRef.is_immediate and (OldRef.Offset = NewRef.Offset)
+  Else
+    RefsEquivalent := (OldRef.Offset+OldRef.OffsetFixup =
+                         NewRef.Offset+NewRef.OffsetFixup) And
+                      RegsEquivalent(OldRef.Base, NewRef.Base, OpAct)
+{$ifdef RefsHaveindexReg}
+                      And RegsEquivalent(OldRef.Index, NewRef.Index, OpAct)
+{$endif RefsHaveIndexReg}
+{$ifdef RefsHaveScale}
+                      And (OldRef.ScaleFactor = NewRef.ScaleFactor)
+{$endif RefsHaveScale}
+                      And (OldRef.Symbol = NewRef.Symbol)
+{$ifdef RefsHaveSegment}
+                      And (OldRef.Segment = NewRef.Segment)
+{$endif RefsHaveSegment}
+                      ;
+End;
+
+Function TRegInfo.OpsEquivalent(const OldOp, NewOp: toper; OpAct: TopAction):
+           Boolean;
+Begin
+  OpsEquivalent := False;
+  if OldOp.typ=NewOp.typ then
+    Case OldOp.typ Of
+      Top_Const: OpsEquivalent := OldOp.val = NewOp.val;
+      Top_Reg: OpsEquivalent := RegsEquivalent(OldOp.reg,NewOp.reg, OpAct);
+      Top_Ref: OpsEquivalent := RefsEquivalent(OldOp.ref^, NewOp.ref^, OpAct);
+      Top_None: OpsEquivalent := True
+    End;
+End;
+
+Function TRegInfo.InstructionsEquivalent(OldP, NewP: Pai): Boolean;
+
+  Function OperandTypesEqual: Boolean;
+  Var Count: AWord;
+  Begin
+    OperandTypesEqual := False;
+    For Count := 0 to max_operands-1 Do
+      If (PInstr(OldP)^.oper[Count].typ <> PInstr(NewP)^.oper[Count].typ) Then
+        Exit;
+    OperandTypesEqual := True
+  End;
+
+Var Count: AWord;
+    TmpResult: Boolean;
+Begin
+  If Assigned(OldP) And Assigned(NewP) And
+     (Pai(OldP)^.typ = ait_instruction) And
+     (Pai(NewP)^.typ = ait_instruction) And
+     (PInstr(OldP)^.opcode = PInstr(NewP)^.opcode) And
+     OperandTypesEqual
+    Then
+{ both instructions have the same structure:                }
+{ "<operator> <operand of type1>, <operand of type 2>, ..." }
+      If IsLoadMemReg(OldP) Then
+{ then also NewP = loadmemreg because of the previous check }
+        If Not(RegInRef(PInstr(OldP)^.oper[LoadDst].reg,
+                 PInstr(OldP)^.oper[LoadSrc].ref^)) Then
+{ the "old" instruction is a load of a register with a new value, not with }
+{ a value based on the contents of this register (so no "mov (reg), reg")  }
+          If Not(RegInRef(PInstr(NewP)^.oper[LoadDst].reg,
+                          PInstr(NewP)^.oper[LoadSrc].ref^)) And
+             RefsEqual(PInstr(OldP)^.oper[LoadSrc].ref^,
+                       PInstr(NewP)^.oper[LoadSrc].ref^)
+            Then
+{ the "new" instruction is also a load of a register with a new value, and }
+{ this value is fetched from the same memory location                      }
+              Begin
+                With PInstr(NewP)^.oper[LoadSrc].ref^ Do
+                  Begin
+                    If Not(Base in [ProcInfo.FramePointer, R_NO, stack_pointer])
+{ it won't do any harm if the register is already in RegsLoadedForRef }
+                      Then RegsLoadedForRef := RegsLoadedForRef + [Base];
+{$ifdef RefsHaveIndexReg}
+                    If Not(Index in [ProcInfo.FramePointer, R_NO, stack_pointer])
+                      Then RegsLoadedForRef := RegsLoadedForRef + [Index];
+{$endif RefsHaveIndexReg}
+                  End;
+{ add the registers from the reference (.oper[Src]) to the RegInfo, all }
+{ registers from the reference are the same in the old and in the new   }
+{ instruction sequence (refsequal returned true)                        }
+                AddOp(PInstr(OldP)^.oper[LoadSrc], PInstr(OldP)^.oper[LoadSrc]);
+{ the registers from .oper[Dest] have to be equivalent, but not necessarily }
+{ equal                                                                     }
+                InstructionsEquivalent :=
+                  RegsEquivalent(PInstr(OldP)^.oper[LoadDst].reg,
+                                 PInstr(NewP)^.oper[LoadDst].reg, OpAct_Write);
+              End
+{ the registers are loaded with values from different memory locations. If }
+{ this were allowed, the instructions "mov -4(%esi),%eax" and              }
+{  "mov -4(%ebp),%eax" would be considered equivalent                      }
+            Else InstructionsEquivalent := False
+        Else
+{ load register with a value based on the current value of this register }
+          Begin
+            With PInstr(NewP)^.oper[0].ref^ Do
+{ Assume the registers occurring in the reference have only been loaded with }
+{ the value they contain now to calculate an address (so the value they have }
+{ now, won't be stored to memory later on)                                   }
+              Begin
+                If Not(Base in [ProcInfo.FramePointer,
+                                RegMaxSize(PInstr(NewP)^.oper[LoadDst].reg),
+                                R_NO,stack_pointer])
+{ It won't do any harm if the register is already in RegsLoadedForRef }
+                  Then
+                    Begin
+                      RegsLoadedForRef := RegsLoadedForRef + [Base];
+{$ifdef csdebug}
+                      Writeln(att_reg2str[base], ' added');
+{$endif csdebug}
+                    end;
+{$Ifdef RefsHaveIndexReg}
+                If Not(Index in [ProcInfo.FramePointer,
+                                 RegMaxSize(PInstr(NewP)^.oper[LoadDst].reg),
+                                 R_NO,StackPtr])
+                  Then
+                    Begin
+                      RegsLoadedForRef := RegsLoadedForRef + [Index];
+{$ifdef csdebug}
+                      Writeln(att_reg2str[index], ' added');
+{$endif csdebug}
+                    end;
+{$endif RefsHaveIndexReg}
+              End;
+
+{ now, remove the destination register of the load from the                 }
+{ RegsLoadedForReg, since if it's loaded with a new value, it certainly     }
+{ will still be used later on                                               }
+            If Not(RegMaxSize(PInstr(NewP)^.oper[LoadDst].reg) In
+                [ProcInfo.FramePointer,R_NO,stack_pointer])
+              Then
+                Begin
+                  RegsLoadedForRef := RegsLoadedForRef -
+                    [RegMaxSize(PInstr(NewP)^.oper[LoadDst].reg)];
+{$ifdef csdebug}
+                  Writeln(att_reg2str[RegMaxSize(PInstr(NewP)^.oper[1].reg)], ' removed');
+{$endif csdebug}
+                end;
+            InstructionsEquivalent :=
+               OpsEquivalent(PInstr(OldP)^.oper[LoadSrc],
+                             PInstr(NewP)^.oper[LoadSrc], OpAct_Read) And
+               OpsEquivalent(PInstr(OldP)^.oper[LoadDst],
+                             PInstr(NewP)^.oper[LoadDst], OpAct_Write)
+          End
+      Else
+{ OldP and NewP are not a load instruction, but have the same structure }
+{ (opcode, operand types), so they're equivalent if all operands are    }
+{ equivalent                                                            }
+       Begin
+         Count := 0;
+         TmpResult := true;
+         Repeat
+           TmpResult :=
+             OpsEquivalent(PInstr(OldP)^.oper[Count], PInstr(NewP)^.oper[Count],
+                           OpAct_Unknown);
+           Inc(Count)
+         Until (Count = MaxOps) or not(TmpResult);
+         InstructionsEquivalent := TmpResult
+       End
+{ the instructions haven't even got the same structure, so they're certainly }
+{ not equivalent                                                             }
+    Else InstructionsEquivalent := False;
+End;
+
+
+Function TRegInfo.CheckSequence(p: Pai; Reg: TRegister; Var Found: Longint):
+           Boolean;
+{checks whether the current instruction sequence (starting with p) and the
+ one between StartMod and EndMod of Reg are the same. If so, the number of
+ instructions that match is stored in Found and true is returned, otherwise
+ Found holds the number of instructions between StartMod and EndMod and false
+ is returned}
+
+{ note: the NrOfMods field can hold two deifferent values depending on      }
+{ which instruction it belongs to:                                          }
+{   * if it is the first instruction of a sequence that describes the       }
+{     contents of a register, NrOfMods contains how many instructions are   }
+{      in the sequence                                                      }
+{   * otherwise, NrOfMods contains how many instructions are in the         }
+{     describing the contents of the register after the current instruction }
+{     has been executed                                                     }
+
+Var oldp, newp: Pai;
+    PrevNonRemovablePai: Pai;
+    OrgRegInfo, HighRegInfo: PRegInfo;
+    HighFound, OrgRegFound: Byte;
+    RegCounter: TRegister;
+    OrgRegResult: Boolean;
+    TmpResult: Boolean;
+    OldNrOfMods: Byte;
+Begin {CheckSequence}
+  Reg := RegMaxSize(Reg);
+{ have we found a sequence of instructions equivalent to the new one? }
+  TmpResult := False;
+{ HighRegInfo will contain the RegInfo for the longest sequence of matching }
+{ instructions found                                                        }
+  New(HighRegInfo, Init);
+{ how many instructions are in the sequence describing the content of Reg }
+{ (the parameter) in the old sequence                                     }
+  OrgRegFound := 0;
+{ how many instructions are in the longest sequence of matching }
+{ instructions found until now?                                 }
+  HighFound := 0;
+{ does the content of Reg in the old equence match the content of Reg in }
+{ the new sequence                                                       }
+  OrgRegResult := False;
+  RegCounter := LoGPReg;
+{ PrevNonRemovablePai's OptInfo contains the contents of the registers   }
+{ before the current instruction is executed. It will be used to compare }
+{ the new contents with and to see whether the new instructions can be   }
+{ removed                                                                }
+  GetLastInstruction(p, PrevNonRemovablePai);
+{ don't check registers that only contain a constant or something unknown }
+  While (RegCounter <= HiGPReg And
+        (PPaiProp(PrevNonRemovablePai^.OptInfo)^.Regs[RegCounter].Typ <> Con_Ref) Do
+    Inc(RegCounter);
+  While (RegCounter <= HiGPReg) Do
+    Begin
+      { reinitialize the reginfo fields }
+      Init;
+      { no matching instructions found yet }
+      Found := 0;
+      With PPaiProp(PrevNonRemovablePai^.OptInfo)^.Regs[RegCounter] Do
+        Begin
+          { get the first instruction that describes the content of the }
+          { the register we're going to check the way it was before the }
+          { current instruction got executed                            }
+          oldp := StartMod;
+          { how many instructions describe the content of the register }
+          { before the current instructions got executed?              }
+          OldNrOfMods := NrOfMods
+        End;
+      { p is the first instruction that describes the content of Reg }
+      { after p (= the current instruction) got executed             }
+      newp := p;
+      { it's possible that the old contents of the current register are   }
+      { described by a sequence of instructions that also contains the    }
+      { one in parameter p. In that case, we have to compare until we     }
+      { encounter p. Otherwise, compare as much instructions as there are }
+      { in the old sequence or until there's a mismatch                   }
+      While  (p <> oldp) And
+             (Found < OldNrOfMods) And
+                                  { old  new }
+             InstructionsEquivalent(oldp, newp, RegInfo) Do
+        Begin
+          GetNextInstruction(oldp, oldp);
+          GetNextInstruction(newp, newp);
+          Inc(Found)
+        End;
+      If (Found < OldNrOfMods) Then
+        Begin
+          { the old sequence was longer than than the new one, so no match }
+          TmpResult := False;
+          { If there is no match, we have to set the CanBeRemoved flag of   }
+          { all pai objects part of the new sequence to false, because it's }
+          { possible that some of them have already been scheduled for      }
+          { removal after checking another sequence (an instruction can be  }
+          { of more than one sequence). If we return false, the number      }
+          { returned in found denotes how many instructions have to have    }
+          { their CanBeRemoved flag set to false                            }
+          { We only have to set those flags to false if their was a partial }
+          { match of instructions (found > 0), because otherwise they can't }
+          { have been set to true in a previous comparison                  }
+          If (found > 0) Then
+            Found := PPaiProp(Pai(p)^.OptInfo)^.Regs[Reg].NrOfMods
+        End
+      Else TmpResult := True;
+      If (RegCounter = Reg) Then
+        Begin
+          OrgRegFound := Found;
+          OrgRegResult := TmpResult;
+          New(OrgRegInfo, InitWithValue(RegInfo));
+        End
+      Else
+        If TmpResult And
+           (Found > HighFound) Then
+          Begin
+            HighFound := Found;
+            HighRegInfo^.InitWithValue(RegInfo);
+          End;
+      RegInfo.Done;
+      Repeat
+        Inc(RegCounter);
+      Until (RegCounter > HiGPReg) or
+            (PPaiProp(PrevNonRemovablePai^.OptInfo)^.Regs[RegCounter].Typ =
+              Con_Ref);
+    End;
+  If (HighFound > 0) And
+     (Not(OrgRegResult) Or
+      (HighFound > OrgRegFound)) Then
+    Begin
+      CheckSequence := True;
+      Found := HighFound
+      InitWithValue(HighRegInfo);
+    End
+  Else
+    Begin
+      CheckSequence := OrgRegResult;
+      Found := OrgRegFound;
+      InitWithValue(OrgRegInfo);
+    End;
+    Dispose(HighRegInfo, Done);
+    Dispose(OrgRegInfo, Done)
+End; {CheckSequence}
+
+
+{ ************************************************************************* }
+{ ******************************* TAOptCSE ******************************** }
+{ ************************************************************************* }
+
+
+Function TAOptCSE.RegModifiedByInstruction(Reg: TRegister; p1: Pai): Boolean;
+Var hp: Pai;
+Begin
+  If GetLastInstruction(p1, hp)
+    Then
+      RegModifiedByInstruction :=
+        PPAiProp(p1^.OptInfo)^.GetWState <>
+          PPAiProp(hp^.OptInfo)^.GetWState
+    Else RegModifiedByInstruction := True;
+End;
+
+Procedure TAoptCSE.RestoreContents(Current: Pai; Reg: TRegister);
+Var Prev, hp3, hp5: Pai;
+    TmpState: TStateInt;
+    Cnt, Cnt2: Byte;
+Begin
+{ load Cnt2 with the total number of instructions of this sequence }
+  Cnt2 := PPaiProp(Prev^.OptInfo)^.Regs[RegInfo.New2OldReg[reg]].
+    NrOfMods;
+{ sometimes, a register can not be removed from a sequence, because it's }
+{ still used afterwards:                                                 }
+{                                                                        }
+{ movl    -8(%ebp), %eax                        movl    -8(%ebp), %eax   }
+{ movl    70(%eax), %eax                        movl    70(%eax), %eax   }
+{ cmpl    74(%eax), %eax                        cmpl    74(%eax), %eax   }
+{ jne     l1               can't be changed to  jne     l1               }
+{ movl    -8(%ebp), %eax                                                 }
+{ movl    70(%eax), %edi                        movl    %eax, %edi       }
+{ boundl  R_282, %edi                           boundl  R_282, %edi      }
+{ pushl   70(%eax)                              pushl   70(%eax)         }
+{                                                                        }
+{ because eax now contains the wrong value when 70(%eax) is pushed       }
+
+{ start at the first instruction of the sequence }
+  hp3 := Current;
+  For Cnt := 1 to Pred(Cnt2) Do
+    GetNextInstruction(hp3, hp3);
+{ hp3 now containts the last instruction of the sequence }
+{ get the writestate at this point of the register in TmpState }
+  TmpState := PPaiProp(hp3^.OptInfo)^.GetWState(reg);
+{ hp3 := first instruction after the sequence }
+  GetNextInstruction(hp3, hp3);
+
+{ now, even though reg is in RegsLoadedForRef, sometimes it's still used  }
+{ afterwards. It is not if either it is not in usedregs anymore after the }
+{ sequence, or if it is loaded with a new value right after the sequence  }
+  If (TmpState <> PPaiProp(hp3^.OptInfo)^.Regs[reg].WState) Or
+     Not(reg in PPaiProp(hp3^.OptInfo)^.UsedRegs) Then
+{ the register is not used anymore after the sequence! }
+    Begin
+{$ifdef csdebug}
+      Writeln('Cnt2: ',Cnt2);
+      hp5 := new(pai_asm_comment,init(strpnew('starting here...')));
+      InsertLLItem(Pai(Current^.previous), Current, hp5);
+{$endif csdebug}
+      hp3 := Current;
+{ first change the contents of the register inside the sequence }
+      For Cnt := 1 to Cnt2 Do
+        Begin
+ {save the WState of the last pai object of the sequence for later use}
+          TmpState := PPaiProp(hp3^.OptInfo)^.Regs[reg].WState;
+{$ifdef csdebug}
+          hp5 := new(pai_asm_comment,init(strpnew('WState for '+
+            att_reg2str[reg]+': '+tostr(tmpstate))));
+          InsertLLItem(hp3, pai(hp3^.next), hp5);
+{$endif csdebug}
+          PPaiProp(hp3^.OptInfo)^.Regs[reg] :=
+            PPaiProp(Prev^.OptInfo)^.Regs[reg];
+          GetNextInstruction(hp3, hp3);
+        End;
+{ here, hp3 = p = Pai object right after the sequence, TmpState = WState of }
+{ reg at the last Pai object of the sequence                                }
+      GetLastInstruction(hp3, hp3);
+{ now, as long as the register isn't modified after the sequence, set its }
+{ contents to what they were before the sequence                          }
+      While GetNextInstruction(hp3, hp3) And
+            (PPaiProp(hp3^.OptInfo)^.GetWState(Reg) = TmpState) Do
+{$ifdef csdebug}
+        begin
+          hp5 := new(pai_asm_comment,init(strpnew('WState for '+att_reg2str[reg]+': '+
+                 tostr(PPaiProp(hp3^.OptInfo)^.GetWState(reg)))));
+             InsertLLItem(hp3, pai(hp3^.next), hp5);
+{$endif csdebug}
+          PPaiProp(hp3^.OptInfo)^.Regs[reg] :=
+            PPaiProp(Prev^.OptInfo)^.Regs[reg];
+{$ifdef csdebug}
+        end;
+{$endif csdebug}
+    End
+  Else
+{ the register is still used after the sequence, so undelete all }
+{ instructions in the sequence that modify reg                   }
+    Begin
+{$ifdef csdebug}
+      Writeln('Got there for ',att_Reg2Str[reg]);
+{$endif csdebug}
+      hp3 := Current;
+      For Cnt := 1 to Cnt2 Do
+        Begin
+          If RegModifiedByInstruction(reg, hp3) Then
+            PPaiProp(hp3^.OptInfo)^.CanBeRemoved := False;
+          GetNextInstruction(hp3, hp3);
+        End;
+    End;
+{$ifdef csdebug}
+  hp5 := new(pai_asm_comment,init(strpnew('stopping here...')));
+  InsertLLItem(AsmL, hp3, pai(hp3^.next), hp5);
+{$endif csdebug}
+End;
+
+Procedure TAoptCSE.DoCSE;
+{marks the instructions that can be removed by RemoveInstructs. They're not
+ removed immediately because sometimes an instruction needs to be checked in
+ two different sequences}
+Var Cnt, Cnt2: Longint;
+    p, hp1, Current: Pai;
+    hp3, Prev: Pai;
+{$ifdef csdebug}
+    hp5: pai;
+{$endif csdebug}
+    RegInfo: TRegInfo;
+    RegCounter: TRegister;
+    TmpState: Byte;
+Begin
+  p := SkipHead(BlockStart);
+  While (p <> BlockEnd) Do
+    Begin
+      Case p^.typ Of
+        ait_instruction:
+          Begin
+{            Case PInstr(p)^.opcode Of
+              A_CLD: If GetLastInstruction(p, hp1) And
+                        (PPaiProp(hp1^.OptInfo)^.DirFlag = F_NotSet) Then
+                       PPaiProp(Pai(p)^.OptInfo)^.CanBeRemoved := True;}
+              If IsLoadMemReg(p) Then
+                Begin
+                  If (p = PPaiProp(p^.OptInfo)^.Regs[RegMaxSize(
+                       PInstr(p)^.oper[LoadDst].reg)].StartMod) And
+                     GetLastInstruction (p, hp1) And
+                     (hp1^.typ <> ait_marker) Then
+{so we don't try to check a sequence when p is the first instruction of the block}
+                    If CheckSequence(p, PInstr(p)^.oper[LoadDst].reg, Cnt) And
+                       (Cnt > 0) Then
+                      Begin
+                        hp1 := nil;
+{ although it's perfectly ok to remove an instruction which doesn't contain }
+{ the register that we've just checked (CheckSequence takes care of that),  }
+{   the sequence containing this other register should also be completely   }
+{   checked (and either removed or marked as non-removable), otherwise we   }
+{ may get situations like this:                                             }
+{                                                                           }
+{     movl 12(%ebp), %edx                       movl 12(%ebp), %edx         }
+{     movl 16(%ebp), %eax                       movl 16(%ebp), %eax         }
+{     movl 8(%edx), %edx                        movl 8(%edx), %edx          }
+{     movl (%eax), eax                          movl (%eax), eax            }
+{     cmpl %eax, %edx                           cmpl %eax, %edx             }
+{     jnz  l123           getting converted to  jnz  l123                   }
+{     movl 12(%ebp), %edx                       movl 4(%eax), eax           }
+{     movl 16(%ebp), %eax                                                   }
+{     movl 8(%edx), %edx                                                    }
+{     movl 4(%eax), eax                                                     }
+                        Current := p;
+                        Cnt2 := 1;
+{ after this while loop, if hp1 <> nil it will contain the pai object }
+{ that's the start of a sequence that's not completely checked yet    }
+                        While Cnt2 <= Cnt Do
+                          Begin
+                            If (hp1 = nil) And
+                               Not(RegInInstruction(
+                                     PInstr(Current)^.oper[LoadDst].reg,p) Or
+                                   RegInInstruction(RegMaxSize(PInstr(
+                                     Current)^.oper[LoadDst].reg), p)) And
+{ do not recheck a sequence if it's completely part of the one we just }
+{ checked                                                              }
+                               Not(IsLoadMemReg(p) And
+                                   (PPaiProp(p^.OptInfo)^.Regs[RegMaxSize(
+                                      PInstr(p)^.Oper[LoadDst].reg)]
+                                      .NrOfMods <= (Cnt - Cnt2 + 1))) Then
+                              hp1 := p;
+{$ifndef noremove}
+                            PPaiProp(p^.OptInfo)^.CanBeRemoved := True;
+{$endif noremove}
+                            Inc(Cnt2);
+                            GetNextInstruction(p, p);
+                          End;
+{ insert a marker noting that for the following instructions no PPaiProp's }
+{ (containing optimizer info) have been generated, so GetNext/             }
+{ LastInstruction will ignore them (it will use the original instructions) }
+                        hp3 := New(Pai_Marker,Init(NoPropInfoStart));
+                        InsertLLItem(Pai(Current^.Previous), Current, hp3);
+{ Prev is used to get the contents of the registers before the sequence }
+                        GetLastInstruction(Current, Prev);
+{ If some registers were different in the old and the new sequence, move }
+{  the contents of those old registers to the new ones, e.g.             }
+{                                                                        }
+{   mov mem1, reg1                        mov mem1, reg1                 }
+{   ...               can be changed to   ...                            }
+{   mov mem1, reg2                        mov reg1, reg2                 }
+
+{$IfDef CSDebug}
+                        For RegCounter := LoGPReg To HiGPReg Do
+                          If (RegCounter in RegInfo.RegsLoadedForRef) Then
+                            Begin
+                              hp5 := new(pai_asm_comment,init(strpnew(
+                                'New: '+att_reg2str[RegCounter]+', Old: '+
+                                att_reg2str[RegInfo.New2OldReg[RegCounter]])));
+                              InsertLLItem(AsmL, Pai(Current^.previous), Current, hp5);
+                            End;
+{$EndIf CSDebug}
+                        For RegCounter := LoGPReg to HiGPReg Do
+                          Begin
+{ if New2OldReg[RegCounter] = R_NO, it means this register doesn't appear }
+{ the new nor the old sequence                                            }
+                            If (RegInfo.New2OldReg[RegCounter] <> R_NO) Then
+{ if a register is in RegsLoadedForRef, it means this register was loaded }
+{ with a value only to function as a base or index in a reference. The    }
+{ practical upshot of this is that this value won't be used anymore later }
+{ on, so even if another register was used in the new sequence for this,  }
+{ we don't have to load it. E.g.                                          }
+{                                                                         }
+{ movl 8(%ebp), %eax                        "                             }
+{ movl 4(%eax), %eax                        "                             }
+{ movl (%eax), %edi                         "                             }
+{ movl %edi, 12(%ebp)                       "                             }
+{ ...                   can be changed to   "                             }
+{ movl 8(%ebp), %edx                                                      }
+{ movl 4(%edx), %edx                                                      }
+{ movl (%edx), %ebx                         movl %edi, %ebx               }
+{                                                                         }
+{ There is no need to also add a "movl %eax, %edx"                        }
+                              If Not(RegCounter In RegInfo.RegsLoadedForRef) And
+                                             {old reg              new reg}
+{ no need to reload the register if it's the same in the old and new }
+{ sequence                                                           }
+                                 (RegInfo.New2OldReg[RegCounter] <> RegCounter) Then
+
+                                Begin
+                                  hp3 := a_load_reg_reg(
+                                                 {old reg          new reg}
+                                    RegInfo.New2OldReg[RegCounter], RegCounter));
+                                  InsertLLItem(Pai(Current^.previous), Current, hp3);
+                                End
+                              Else
+{ As noted before, if a register is in RegsLoadedForRef, it doesn't have  }
+{ to be loaded. However, when data flow analyzer processed this code, the }
+{ was loaded, so we need to change that. This is done by setting the      }
+{ contents of the register to its contents before the new sequence, for   }
+{ every instruction until the first load of the register with a new value }
+                                If (RegCounter In RegInfo.RegsLoadedForRef) Then
+                                  RestoreOrigContents(Current, RegCounter);
+
+                          End;
+{ the end of the area where instructions without optimizer info can occur }
+                        hp3 := New(Pai_Marker,Init(NoPropInfoEnd));
+                        InsertLLItem(AsmL, Pai(Current^.Previous), Current, hp3);
+{ if we found an instruction sequence that needs complete re-evaluation, }
+{ process it                                                             }
+                        If hp1 <> nil Then p := hp1;
+                        Continue;
+                      End
+                    Else
+{ checksequence returned false. In that case, if the current instruction }
+{ was already deleted (as part of another sequence), we have to undelete }
+{ all instructions pertaining to the register whose sequence we just     }
+{ checked                                                                }
+                      If (Cnt > 0) And
+                         (PPaiProp(p^.OptInfo)^. Regs[RegMaxSize(PInstr(p)^.
+                            oper[LoadDst].reg)].Typ = Con_Ref) And
+                         (PPaiProp(p^.OptInfo)^.CanBeRemoved) Then
+                        Begin
+                          Current := p;
+                          Cnt2 := 1;
+                          While Cnt2 <= Cnt Do
+                            Begin
+                              If RegInInstruction(PInstr(Current)^.
+                                   oper[LoadDst].reg, p) Or
+                                 RegInInstruction(RegMaxSize(PInstr(Current)^.
+                                   oper[LoadDst].reg), p) Then
+                                PPaiProp(p^.OptInfo)^.CanBeRemoved := False;
+                              Inc(Cnt2);
+                              GetNextInstruction(p, p);
+                            End;
+                          Continue;
+                        End;
+                End
+              Else if IsLoadConstReg(p) Then
+                Begin
+                  If GetLastInstruction(p, hp1) Then
+                    With PPaiProp(hp1^.OptInfo)^.Regs[
+                           RegMaxSize(PInstr(p)^.oper[LoadDst].reg)] Do
+                      If (Typ = Con_Const) And
+                         (StartMod = p) Then
+                        PPaiProp(p^.OptInfo)^.CanBeRemoved := True;
+                End
+              Else
+                CpuCSE(p);
+{              A_STD: If GetLastInstruction(p, hp1) And
+                        (PPaiProp(hp1^.OptInfo)^.DirFlag = F_Set) Then
+                        PPaiProp(Pai(p)^.OptInfo)^.CanBeRemoved := True;
+              A_XOR:
+                Begin
+                  If (Paicpu(p)^.oper[0].typ = top_reg) And
+                     (Paicpu(p)^.oper[0].typ = top_reg) And
+                     (Paicpu(p)^.oper[1].reg = Paicpu(p)^.oper[1].reg) And
+                     GetLastInstruction(p, hp1) And
+                     (PPaiProp(hp1^.OptInfo)^.Regs[Reg32(Paicpu(p)^.oper[1].reg)].typ = con_const) And
+                     (PPaiProp(hp1^.OptInfo)^.Regs[Reg32(Paicpu(p)^.oper[1].reg)].StartMod = nil)
+                    Then PPaiProp(p^.OptInfo)^.CanBeRemoved := True
+                End
+          End;
+      End;
+      GetNextInstruction(p, p);
+    End;
+End;
+
+Procedure RemoveInstructs;
+{Removes the marked instructions and disposes the PPaiProps of the other
+ instructions, restoring their line number}
+Var p, hp1: Pai;
+    InstrCnt: Longint;
+Begin
+ p := SkipHead(BlockStart);
+  InstrCnt := 1;
+  While (p <> BlockEnd) Do
+    Begin
+{$ifndef noinstremove}
+      If PPaiProp(p^.OptInfo)^.CanBeRemoved
+        Then
+          Begin
+            Dispose(PPaiProp(p^.OptInfo));
+            GetNextInstruction(p, hp1);
+            AsmL^.Remove(p);
+            Dispose(p, Done);
+            p := hp1;
+            Inc(InstrCnt);
+          End
+        Else
+{$endif noinstremove}
+          Begin
+            Dispose(PPaiProp(p^.OptInfo));
+            p^.OptInfo := nil;
+            GetNextInstruction(p, p);
+            Inc(InstrCnt);
+          End;
+    End;
+End;
+
+Procedure TAoptCSE.CSE;
+Begin
+  DoCSE;
+  RemoveInstructs;
+End;
+
+
+
+End.
+
+{
+  $Log$
+  Revision 1.1  2001-08-26 13:36:35  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.1  2000/07/13 06:30:07  michael
+  + Initial import
+
+  Revision 1.5  2000/02/28 17:23:58  daniel
+  * Current work of symtable integration committed. The symtable can be
+    activated by defining 'newst', but doesn't compile yet. Changes in type
+    checking and oop are completed. What is left is to write a new
+    symtablestack and adapt the parser to use it.
+
+  Revision 1.4  2000/01/07 01:14:51  peter
+    * updated copyright to 2000
+
+  Revision 1.3  1999/08/25 12:00:10  jonas
+    * changed pai386, paippc and paiapha (same for tai*) to paicpu (taicpu)
+
+  Revision 1.2  1999/08/23 14:41:13  jonas
+    + checksequence (processor independent)\n  + processor independent part of docse
+
+  Revision 1.1  1999/08/18 14:32:21  jonas
+    + compilable!
+    + dataflow analyzer finished
+    + start of CSE units
+    + aoptbase which contains a base object for all optimizer objects
+    * some constants and type definitions moved around to avoid circular
+      dependencies
+    * moved some methods from base objects to specialized objects because
+      they're not used anywhere else
+
+}

compiler/aoptda.pas

@@ -0,0 +1,203 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Jonas Maebe, member of the Free Pascal
+    Development Team
+
+    This unit contains the data flow analyzer object of the assembler
+    optimizer.
+
+    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 aoptda;
+
+Interface
+
+uses aasm, cpubase, aoptcpub, aoptbase, aoptcpu;
+
+Type
+  TAOptDFA = Object(TAoptCpu)
+    { uses the same constructor as TAoptCpu = constructor from TAoptObj }
+
+    { gathers the information regarding the contents of every register }
+    { at the end of every instruction                                  }
+    Procedure DoDFA;
+
+    { handles the processor dependent dataflow analizing               }
+    Procedure CpuDFA(p: PInstr); Virtual;
+
+    { How many instructions are between the current instruction and the }
+    { last one that modified the register                               }
+    InstrSinceLastMod: TInstrSinceLastMod;
+
+    { convert a TInsChange value into the corresponding register }
+    Function TCh2Reg(Ch: TInsChange): TRegister; Virtual;
+    { returns whether the instruction P reads from register Reg }
+    Function RegReadByInstr(Reg: TRegister; p: Pai): Boolean; Virtual;
+  End;
+
+Implementation
+
+uses globals, aoptobj;
+
+Procedure TAOptDFA.DoDFA;
+{ Analyzes the Data Flow of an assembler list. Analyses the reg contents     }
+{ for the instructions between blockstart and blockend. Returns the last pai }
+{ which has been processed                                                   }
+Var
+    CurProp: PPaiProp;
+    UsedRegs: TUsedRegs;
+    p, hp, NewBlockStart : Pai;
+    TmpReg: TRegister;
+Begin
+  p := BlockStart;
+  UsedRegs.init;
+  UsedRegs.Update(p);
+  NewBlockStart := SkipHead(p);
+  { done implicitely by the constructor
+  FillChar(InstrSinceLastMod, SizeOf(InstrSinceLastMod), 0); }
+  While (P <> BlockEnd) Do
+    Begin
+      CurProp := New(PPaiProp, init);
+      If (p <> NewBlockStart) Then
+        Begin
+          GetLastInstruction(p, hp);
+          CurProp^.Regs := PPaiProp(hp^.OptInfo)^.Regs;
+{ !!!!!!!!!!!! }
+{$ifdef i386}
+          CurProp^.CondRegs.Flags :=
+            PPaiProp(hp^.OptInfo)^.CondRegs.Flags;
+{$endif}
+        End;
+      CurProp^.UsedRegs.InitWithValue(UsedRegs.GetUsedRegs);
+      UsedRegs.Update(Pai(p^.Next));
+      PPaiProp(p^.OptInfo) := CurProp;
+      For TmpReg := LoGPReg To HiGPReg Do
+        Inc(InstrSinceLastMod[TmpReg]);
+      Case p^.typ Of
+        ait_label:
+          If (Pai_label(p)^.l^.is_used) Then
+            CurProp^.DestroyAllRegs(InstrSinceLastMod);
+{$ifdef GDB}
+        ait_stabs, ait_stabn, ait_stab_function_name:;
+{$endif GDB}
+        ait_instruction:
+          if not(PInstr(p)^.is_jmp) then
+            begin
+              If IsLoadMemReg(p) Then
+                Begin
+                  CurProp^.ReadRef(PInstr(p)^.oper[LoadSrc].ref);
+                  TmpReg := RegMaxSize(PInstr(p)^.oper[LoadDst].reg);
+                  If RegInRef(TmpReg, PInstr(p)^.oper[LoadSrc].ref^) And
+                     (CurProp^.GetRegContentType(TmpReg) = Con_Ref) Then
+                    Begin
+                      { a load based on the value this register already }
+                      { contained                                       }
+                      With CurProp^.Regs[TmpReg] Do
+                        Begin
+                          CurProp^.IncWState(TmpReg);
+                           {also store how many instructions are part of the  }
+                           { sequence in the first instruction's PPaiProp, so }
+                           { it can be easily accessed from within            }
+                           { CheckSequence                                    }
+                          Inc(NrOfMods, InstrSinceLastMod[TmpReg]);
+                          PPaiProp(Pai(StartMod)^.OptInfo)^.Regs[TmpReg].NrOfMods := NrOfMods;
+                          InstrSinceLastMod[TmpReg] := 0
+                        End
+                    End
+                  Else
+                    Begin
+                      { load of a register with a completely new value }
+                      CurProp^.DestroyReg(TmpReg, InstrSinceLastMod);
+                      If Not(RegInRef(TmpReg, PInstr(p)^.oper[LoadSrc].ref^)) Then
+                        With CurProp^.Regs[TmpReg] Do
+                          Begin
+                            Typ := Con_Ref;
+                            StartMod := p;
+                            NrOfMods := 1;
+                          End
+                    End;
+  {$ifdef StateDebug}
+                    hp := new(pai_asm_comment,init(strpnew(att_reg2str[TmpReg]+': '+tostr(CurProp^.Regs[TmpReg].WState))));
+                    InsertLLItem(AsmL, p, p^.next, hp);
+  {$endif StateDebug}
+
+                End
+              Else if IsLoadConstReg(p) Then
+                Begin
+                  TmpReg := RegMaxSize(PInstr(p)^.oper[LoadDst].reg);
+                  With CurProp^.Regs[TmpReg] Do
+                    Begin
+                      CurProp^.DestroyReg(TmpReg, InstrSinceLastMod);
+                      typ := Con_Const;
+                      StartMod := Pointer(PInstr(p)^.oper[LoadSrc].val);
+                    End
+                End
+              Else CpuDFA(Pinstr(p));
+            End;
+        Else CurProp^.DestroyAllRegs(InstrSinceLastMod);
+      End;
+{      Inc(InstrCnt);}
+      GetNextInstruction(p, p);
+    End;
+End;
+
+Procedure TAoptDFA.CpuDFA(p: PInstr);
+Begin
+  Abstract;
+End;
+
+Function TAOptDFA.TCh2Reg(Ch: TInsChange): TRegister;
+Begin
+  TCh2Reg:=R_NO;
+  Abstract;
+End;
+
+Function TAOptDFA.RegReadByInstr(Reg: TRegister; p: Pai): Boolean;
+Begin
+  RegReadByInstr:=false;
+  Abstract;
+End;
+
+
+End.
+
+{
+  $Log$
+  Revision 1.1  2001-08-26 13:36:35  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.1  2000/07/13 06:30:07  michael
+  + Initial import
+
+  Revision 1.6  2000/01/07 01:14:52  peter
+    * updated copyright to 2000
+
+  Revision 1.5  1999/11/09 22:57:08  peter
+    * compiles again both i386,alpha both with optimizer
+
+  Revision 1.4  1999/08/18 14:32:21  jonas
+    + compilable!
+    + dataflow analyzer finished
+    + start of CSE units
+    + aoptbase which contains a base object for all optimizer objects
+    * some constants and type definitions moved around to avoid circular
+      dependencies
+    * moved some methods from base objects to specialized objects because
+      they're not used anywhere else
+
+}

compiler/aoptobj.pas

@@ -0,0 +1,831 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Jonas Maebe, member of the Free Pascal
+    Development Team
+
+    This unit contains the processor independent assembler optimizer
+    object, base for the dataflow analyzer, peepholeoptimizer and
+    common subexpression elimination objects.
+
+    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 AoptObj;
+
+{ general, processor independent objects for use by the assembler optimizer }
+
+Interface
+
+uses aasm, cclasses, cpuinfo, cpubase, cpuasm, aoptbase, aoptcpub;
+
+{ ************************************************************************* }
+{ ********************************* Constants ***************************** }
+{ ************************************************************************* }
+
+Const
+
+{Possible register content types}
+  con_Unknown = 0;
+  con_ref = 1;
+  con_const = 2;
+
+{***************** Types ****************}
+
+Type
+
+{ ************************************************************************* }
+{ ************************* Some general type definitions ***************** }
+{ ************************************************************************* }
+  TRefCompare = Function(const r1, r2: TReference): Boolean;
+  TRegArray = Array[LoReg..HiReg] of TRegister;
+  TRegSet = Set of LoReg..HiReg;
+{ possible actions on an operand: read, write or modify (= read & write) }
+  TOpAction = (OpAct_Read, OpAct_Write, OpAct_Modify, OpAct_Unknown);
+
+{ ************************************************************************* }
+{ * Object to hold information on which regiters are in use and which not * }
+{ ************************************************************************* }
+  TUsedRegs = Object
+    Constructor init;
+    Constructor InitWithValue(Const _RegSet: TRegSet);
+    { update the info with the pairegalloc objects coming after }
+    { p                                                         }
+    Procedure Update(p: Tai);
+    { is Reg currently in use }
+    Function IsUsed(Reg: TRegister): Boolean;
+    { get all the currently used registers }
+    Function GetUsedRegs: TRegSet;
+    Destructor Done;
+
+    Private
+
+    UsedRegs: TRegSet;
+  End;
+
+{ ************************************************************************* }
+{ ******************* Contents of the integer registers ******************* }
+{ ************************************************************************* }
+
+ { size of the integer that holds the state number of a register. Can be any }
+ { integer type, so it can be changed to reduce the size of the TContent     }
+ { structure or to improve alignment                                         }
+  TStateInt = Byte;
+
+  TContent = Packed Record
+    { start and end of block instructions that defines the }
+    { content of this register. If Typ = con_const, then   }
+    { Longint(StartMod) = value of the constant)           }
+    StartMod: Tai;
+    { starts at 0, gets increased everytime the register is }
+    { written to                                            }
+    WState: TStateInt;
+    { starts at 0, gets increased everytime the register is read }
+    { from                                                       }
+    RState: TStateInt;
+    { how many instructions starting with StarMod does the block }
+    { consist of                                                 }
+    NrOfMods: Byte;
+    { the type of the content of the register: unknown, memory   }
+    { (variable) or constant                                     }
+    Typ: Byte;
+  End;
+
+  TRegContent = Array[LoGPReg..HiGPReg] Of TContent;
+
+{ ************************************************************************** }
+{ information object with the contents of every register. Every Tai object   }
+{ gets one of these assigned: a pointer to it is stored in the OptInfo field }
+{ ************************************************************************** }
+
+  PPaiProp = ^TPaiProp;
+
+  TPaiProp = Object(TAoptBaseCpu)
+    Regs: TRegContent;
+    { info about allocation of general purpose integer registers }
+    UsedRegs: TUsedRegs;
+    { info about the conditional registers }
+    CondRegs: TCondRegs;
+    { can this instruction be removed? }
+    CanBeRemoved: Boolean;
+
+    Constructor init;
+
+    { checks the whole sequence of which (so regs[which].StartMod and and  }
+    { the next NrOfMods Tai objects) to see whether Reg is used somewhere, }
+    { without it being loaded with something else first                    }
+    Function RegInSequence(Reg, which: TRegister): Boolean;
+    { destroy the contents of a register, as well as those whose contents }
+    { are based on those of that register                                 }
+    Procedure DestroyReg(Reg: TRegister; var InstrSinceLastMod:
+      TInstrSinceLastMod);
+    { if the contents of WhichReg (can be R_NO in case of a constant) are  }
+    { written to memory at the location Ref, the contents of the registers }
+    { that depend on Ref have to be  destroyed                             }
+    Procedure DestroyRefs(Const Ref: TReference; WhichReg: TRegister; var
+      InstrSinceLastMod: TInstrSinceLastMod);
+
+    { an instruction reads from operand o }
+    Procedure ReadOp(const o:toper);
+    { an instruction reads from reference Ref }
+    Procedure ReadRef(Ref: PReference);
+    { an instruction reads from register Reg }
+    Procedure ReadReg(Reg: TRegister);
+
+    { an instruction writes/modifies operand o and this has special     }
+    { side-effects or modifies the contents in such a way that we can't }
+    { simply add this instruction to the sequence of instructions that  }
+    { describe the contents of the operand, so destroy it               }
+    Procedure DestroyOp(const o:Toper; var InstrSinceLastMod:
+      TInstrSinceLastMod);
+    { destroy the contents of all registers }
+    Procedure DestroyAllRegs(var InstrSinceLastMod: TInstrSinceLastMod);
+    { a register's contents are modified, but not destroyed (the new value }
+    { depends on the old one)                                              }
+    Procedure ModifyReg(reg: TRegister; var InstrSinceLastMod:
+      TInstrSinceLastMod);
+    { an operand's contents are modified, but not destroyed (the new value }
+    { depends on the old one)                                              }
+    Procedure ModifyOp(const oper: TOper; var InstrSinceLastMod:
+      TInstrSinceLastMod);
+
+    { increase the write state of a register (call every time a register is }
+    { written to)                                                           }
+    Procedure IncWState(Reg: TRegister);
+    { increase the read state of a register (call every time a register is }
+    { read from)                                                           }
+    Procedure IncRState(Reg: TRegister);
+    { get the write state of a register }
+    Function GetWState(Reg: TRegister): TStateInt;
+    { get the read state of a register }
+    Function GetRState(Reg: TRegister): TStateInt;
+
+    { get the type of contents of a register }
+    Function GetRegContentType(Reg: TRegister): Byte;
+
+    Destructor Done;
+
+    Private
+
+    Procedure IncState(var s: TStateInt);
+
+    { returns whether the reference Ref is used somewhere in the loading }
+    { sequence Content                                                   }
+    Function RefInSequence(Const Ref: TReference; Content: TContent;
+      RefsEq: TRefCompare): Boolean;
+
+   { returns whether the instruction P reads from and/or writes }
+   { to Reg                                                     }
+   Function RefInInstruction(Const Ref: TReference; p: Tai;
+     RefsEq: TRefCompare): Boolean;
+
+   { returns whether two references with at least one pointing to an array }
+   { may point to the same memory location                                 }
+
+  End;
+
+
+{ ************************************************************************* }
+{ ************************ Label information ****************************** }
+{ ************************************************************************* }
+  TLabelTableItem = Record
+    PaiObj: Tai;
+  End;
+
+{$ifndef TP}
+  TLabelTable = Array[0..2500000] Of TLabelTableItem;
+{$else TP}
+  TLabelTable = Array[0..(65520 div sizeof(TLabelTableItem))] Of TLabelTableItem;
+{$endif TP}
+  PLabelTable = ^TLabelTable;
+  PLabelInfo = ^TLabelInfo;
+  TLabelInfo = Record
+    { the highest and lowest label number occurring in the current code }
+    { fragment                                                          }
+    LowLabel, HighLabel: AWord;
+    LabelDif: AWord;
+    { table that contains the addresses of the Pai_Label objects associated }
+    { with each label number                                                }
+    LabelTable: PLabelTable;
+  End;
+
+{ ************************************************************************* }
+{ ********** General optimizer object, used to derive others from ********* }
+{ ************************************************************************* }
+
+  TAOptObj = Object(TAoptBaseCpu)
+    { the PAasmOutput list this optimizer instance works on }
+    AsmL: TAasmOutput;
+
+    { The labelinfo record contains the addresses of the Tai objects }
+    { that are labels, how many labels there are and the min and max }
+    { label numbers                                                  }
+    LabelInfo: PLabelInfo;
+
+    { Start and end of the block that is currently being optimized }
+    BlockStart, BlockEnd: Tai;
+
+    { _AsmL is the PAasmOutpout list that has to be optimized,     }
+    { _BlockStart and _BlockEnd the start and the end of the block }
+    { that has to be optimized and _LabelInfo a pointer to a       }
+    { TLabelInfo record                                            }
+    Constructor Init(_AsmL: TAasmOutput; _BlockStart, _BlockEnd: Tai;
+                       _LabelInfo: PLabelInfo);
+
+    { processor independent methods }
+
+    { returns true if the label L is found between hp and the next }
+    { instruction                                                  }
+    Function FindLabel(L: TasmLabel; Var hp: Tai): Boolean;
+
+    { inserts new_one between prev and foll in AsmL }
+    Procedure InsertLLItem(prev, foll, new_one: TLinkedListItem);
+
+
+    { If P is a Tai object releveant to the optimizer, P is returned   }
+    { If it is not relevant tot he optimizer, the first object after P }
+    { that is relevant is returned                                     }
+    Function SkipHead(P: Tai): Tai;
+
+    { returns true if the operands o1 and o2 are completely equal }
+    Function OpsEqual(const o1,o2:toper): Boolean;
+
+    { Returns true if a ait_alloc object for Reg is found in the block }
+    { of Tai's starting with StartPai and ending with the next "real"  }
+    { instruction                                                      }
+    Function FindRegAlloc(Reg: TRegister; StartPai: Tai): Boolean;
+
+    { processor dependent methods }
+
+  End;
+
+   Function ArrayRefsEq(const r1, r2: TReference): Boolean;
+
+{ ***************************** Implementation **************************** }
+
+Implementation
+
+uses globtype, globals, cgbase, tainst;
+
+{ ************************************************************************* }
+{ ******************************** TUsedRegs ****************************** }
+{ ************************************************************************* }
+
+Constructor TUsedRegs.init;
+Begin
+  UsedRegs := [];
+End;
+
+Constructor TUsedRegs.InitWithValue(Const _RegSet: TRegSet);
+Begin
+  UsedRegs := _RegSet;
+End;
+
+Procedure TUsedRegs.Update(p: Tai);
+{updates UsedRegs with the RegAlloc Information coming after P}
+Begin
+  Repeat
+    While Assigned(p) And
+          ((p.typ in (SkipInstr - [ait_RegAlloc])) or
+           ((p.typ = ait_label) And
+            Not(Tai_Label(p).l.is_used))) Do
+         p := Tai(p.next);
+    While Assigned(p) And
+          (p.typ=ait_RegAlloc) Do
+      Begin
+        if Tairegalloc(p).allocation then
+          UsedRegs := UsedRegs + [TaiRegAlloc(p).Reg]
+        else
+          UsedRegs := UsedRegs - [TaiRegAlloc(p).Reg];
+        p := Tai(p.next);
+      End;
+  Until Not(Assigned(p)) Or
+        (Not(p.typ in SkipInstr) And
+         Not((p.typ = ait_label) And
+            Not(Tai_Label(p).l.is_used)));
+End;
+
+Function TUsedRegs.IsUsed(Reg: TRegister): Boolean;
+Begin
+  IsUsed := Reg in UsedRegs
+End;
+
+Function TUsedRegs.GetUsedRegs: TRegSet;
+Begin
+  GetUsedRegs := UsedRegs;
+End;
+
+Destructor TUsedRegs.Done; {$ifdef inl} inline; {$endif inl}
+Begin
+end;
+
+{ ************************************************************************* }
+{ **************************** TPaiProp *********************************** }
+{ ************************************************************************* }
+
+Constructor TPaiProp.Init;
+Begin
+  UsedRegs.Init;
+  CondRegs.init;
+{  DirFlag: TFlagContents; I386 specific}
+End;
+
+Function TPaiProp.RegInSequence(Reg, which: TRegister): Boolean;
+Var p: Tai;
+    RegsChecked: TRegSet;
+    content: TContent;
+    Counter: Byte;
+    TmpResult: Boolean;
+Begin
+  RegsChecked := [];
+  content := regs[which];
+  p := content.StartMod;
+  TmpResult := False;
+  Counter := 1;
+  While Not(TmpResult) And
+        (Counter <= Content.NrOfMods) Do
+    Begin
+      If IsLoadMemReg(p) Then
+        With PInstr(p)^.oper[LoadSrc].ref^ Do
+          If (Base = ProcInfo^.FramePointer)
+{$ifdef RefsHaveIndexReg}
+             And (Index = R_NO)
+{$endif RefsHaveIndexReg} Then
+            Begin
+              RegsChecked := RegsChecked +
+                [RegMaxSize(PInstr(p)^.oper[LoadDst].reg)];
+              If Reg = RegMaxSize(PInstr(p)^.oper[LoadDst].reg) Then
+                Break;
+            End
+          Else
+            Begin
+              If (Base = Reg) And
+                 Not(Base In RegsChecked)
+                Then TmpResult := True;
+{$ifdef RefsHaveIndexReg}
+              If Not(TmpResult) And
+                 (Index = Reg) And
+                   Not(Index In RegsChecked)
+                Then TmpResult := True;
+{$Endif RefsHaveIndexReg}
+            End
+      Else TmpResult := RegInInstruction(Reg, p);
+      Inc(Counter);
+      GetNextInstruction(p,p)
+    End;
+  RegInSequence := TmpResult
+End;
+
+
+Procedure TPaiProp.DestroyReg(Reg: TRegister; var InstrSinceLastMod:
+            TInstrSinceLastMod);
+{ Destroys the contents of the register Reg in the PPaiProp p1, as well as }
+{ the contents of registers are loaded with a memory location based on Reg }
+Var TmpWState, TmpRState: Byte;
+    Counter: TRegister;
+Begin
+  Reg := RegMaxSize(Reg);
+  If (Reg in [LoGPReg..HiGPReg]) Then
+    For Counter := LoGPReg to HiGPReg Do
+      With Regs[Counter] Do
+        If (Counter = reg) Or
+           ((Typ = Con_Ref) And
+            RegInSequence(Reg, Counter)) Then
+          Begin
+            InstrSinceLastMod[Counter] := 0;
+            IncWState(Counter);
+            TmpWState := GetWState(Counter);
+            TmpRState := GetRState(Counter);
+            FillChar(Regs[Counter], SizeOf(TContent), 0);
+            WState := TmpWState;
+            RState := TmpRState
+          End
+End;
+
+Function ArrayRefsEq(const r1, r2: TReference): Boolean;
+Begin
+  ArrayRefsEq := (R1.Offset+R1.OffsetFixup = R2.Offset+R2.OffsetFixup) And
+{$ifdef refsHaveSegmentReg}
+                 (R1.Segment = R2.Segment) And
+{$endif}
+                 (R1.Base = R2.Base) And
+                 (R1.Symbol=R2.Symbol);
+End;
+
+Procedure TPaiProp.DestroyRefs(Const Ref: TReference; WhichReg: TRegister;
+            var InstrSinceLastMod: TInstrSinceLastMod);
+{ destroys all registers which possibly contain a reference to Ref, WhichReg }
+{ is the register whose contents are being written to memory (if this proc   }
+{ is called because of a "mov?? %reg, (mem)" instruction)                    }
+Var RefsEq: TRefCompare;
+    Counter: TRegister;
+Begin
+  WhichReg := RegMaxSize(WhichReg);
+  If (Ref.base = procinfo^.FramePointer) or
+      Assigned(Ref.Symbol) Then
+    Begin
+      If
+{$ifdef refsHaveIndexReg}
+         (Ref.Index = R_NO) And
+{$endif refsHaveIndexReg}
+         (Not(Assigned(Ref.Symbol)) or
+          (Ref.base = R_NO)) Then
+  { local variable which is not an array }
+        RefsEq := {$ifdef fpc}@{$endif}RefsEqual
+      Else
+  { local variable which is an array }
+        RefsEq := {$ifdef fpc}@{$endif}ArrayRefsEq;
+{write something to a parameter, a local or global variable, so
+   * with uncertain optimizations on:
+      - destroy the contents of registers whose contents have somewhere a
+        "mov?? (Ref), %reg". WhichReg (this is the register whose contents
+        are being written to memory) is not destroyed if it's StartMod is
+        of that form and NrOfMods = 1 (so if it holds ref, but is not a
+        pointer or value based on Ref)
+    * with uncertain optimizations off:
+       - also destroy registers that contain any pointer}
+      For Counter := LoGPReg to HiGPReg Do
+        With Regs[Counter] Do
+          Begin
+            If (typ = Con_Ref) And
+               ((Not(cs_UncertainOpts in aktglobalswitches) And
+                 (NrOfMods <> 1)
+                ) Or
+                (RefInSequence(Ref,Regs[Counter], RefsEq) And
+                 ((Counter <> WhichReg) Or
+                  ((NrOfMods <> 1) And
+ {StarMod is always of the type ait_instruction}
+                   (PInstr(StartMod)^.oper[0].typ = top_ref) And
+                   RefsEq(PInstr(StartMod)^.oper[0].ref^, Ref)
+                  )
+                 )
+                )
+               )
+              Then
+                DestroyReg(Counter, InstrSinceLastMod)
+          End
+    End
+  Else
+{write something to a pointer location, so
+   * with uncertain optimzations on:
+      - do not destroy registers which contain a local/global variable or a
+        parameter, except if DestroyRefs is called because of a "movsl"
+   * with uncertain optimzations off:
+      - destroy every register which contains a memory location
+      }
+      For Counter := LoGPReg to HiGPReg Do
+        With Regs[Counter] Do
+          If (typ = Con_Ref) And
+             (Not(cs_UncertainOpts in aktglobalswitches) Or
+{$ifdef i386}
+        {for movsl}
+              (Ref.Base = R_EDI) Or
+{$endif}
+        {don't destroy if reg contains a parameter, local or global variable}
+              Not((NrOfMods = 1) And
+                  (PInstr(StartMod)^.oper[0].typ = top_ref) And
+                  ((PInstr(StartMod)^.oper[0].ref^.base = ProcInfo^.FramePointer) Or
+                    Assigned(PInstr(StartMod)^.oper[0].ref^.Symbol)
+                  )
+                 )
+             )
+          Then DestroyReg(Counter, InstrSinceLastMod)
+End;
+
+Procedure TPaiProp.DestroyAllRegs(var InstrSinceLastMod: TInstrSinceLastMod);
+Var Counter: TRegister;
+Begin {initializes/desrtoys all registers}
+  For Counter := LoGPReg To HiGPReg Do
+    Begin
+      ReadReg(Counter);
+      DestroyReg(Counter, InstrSinceLastMod);
+    End;
+  CondRegs.Init;
+{ FPURegs.Init; }
+End;
+
+Procedure TPaiProp.DestroyOp(const o:Toper; var InstrSinceLastMod:
+            TInstrSinceLastMod);
+Begin
+  Case o.typ Of
+    top_reg: DestroyReg(o.reg, InstrSinceLastMod);
+    top_ref:
+      Begin
+        ReadRef(o.ref);
+        DestroyRefs(o.ref^, R_NO, InstrSinceLastMod);
+      End;
+    top_symbol:;
+  End;
+End;
+
+Procedure TPaiProp.ReadReg(Reg: TRegister);
+Begin
+  Reg := RegMaxSize(Reg);
+  If Reg in General_Registers Then
+    IncRState(RegMaxSize(Reg))
+End;
+
+Procedure TPaiProp.ReadRef(Ref: PReference);
+Begin
+  If Ref^.Base <> R_NO Then
+    ReadReg(Ref^.Base);
+{$ifdef refsHaveIndexReg}
+  If Ref^.Index <> R_NO Then
+    ReadReg(Ref^.Index);
+{$endif}
+End;
+
+Procedure TPaiProp.ReadOp(const o:toper);
+Begin
+  Case o.typ Of
+    top_reg: ReadReg(o.reg);
+    top_ref: ReadRef(o.ref);
+    top_symbol : ;
+  End;
+End;
+
+Procedure TPaiProp.ModifyReg(reg: TRegister; Var InstrSinceLastMod:
+                               TInstrSinceLastMod);
+Begin
+  With Regs[reg] Do
+    If (Typ = Con_Ref)
+      Then
+        Begin
+          IncState(WState);
+ {also store how many instructions are part of the sequence in the first
+  instructions PPaiProp, so it can be easily accessed from within
+  CheckSequence}
+          Inc(NrOfMods, InstrSinceLastMod[Reg]);
+          PPaiProp(StartMod.OptInfo)^.Regs[Reg].NrOfMods := NrOfMods;
+          InstrSinceLastMod[Reg] := 0;
+        End
+      Else
+        DestroyReg(Reg, InstrSinceLastMod);
+End;
+
+Procedure TPaiProp.ModifyOp(const oper: TOper; var InstrSinceLastMod:
+            TInstrSinceLastMod);
+Begin
+  If oper.typ = top_reg Then
+    ModifyReg(RegMaxSize(oper.reg),InstrSinceLastMod)
+  Else
+    Begin
+      ReadOp(oper);
+      DestroyOp(oper, InstrSinceLastMod);
+    End
+End;
+
+Procedure TPaiProp.IncWState(Reg: TRegister);{$ifdef inl} inline;{$endif inl}
+Begin
+  IncState(Regs[Reg].WState);
+End;
+
+Procedure TPaiProp.IncRState(Reg: TRegister);{$ifdef inl} inline;{$endif inl}
+Begin
+  IncState(Regs[Reg].RState);
+End;
+
+Function TPaiProp.GetWState(Reg: TRegister): TStateInt; {$ifdef inl} inline;{$endif inl}
+Begin
+  GetWState := Regs[Reg].WState
+End;
+
+Function TPaiProp.GetRState(Reg: TRegister): TStateInt; {$ifdef inl} inline;{$endif inl}
+Begin
+  GetRState := Regs[Reg].RState
+End;
+
+Function TPaiProp.GetRegContentType(Reg: TRegister): Byte; {$ifdef inl} inline;{$endif inl}
+Begin
+  GetRegContentType := Regs[Reg].typ
+End;
+
+Destructor TPaiProp.Done;
+Begin
+  UsedRegs.Done;
+  CondRegs.Done;
+{  DirFlag: TFlagContents; I386 specific}
+End;
+{ ************************ private TPaiProp stuff ************************* }
+
+Procedure TPaiProp.IncState(Var s: TStateInt); {$ifdef inl} inline;{$endif inl}
+Begin
+  If s <> High(TStateInt) Then Inc(s)
+  Else s := 0
+End;
+
+Function TPaiProp.RefInInstruction(Const Ref: TReference; p: Tai;
+  RefsEq: TRefCompare): Boolean;
+Var Count: AWord;
+    TmpResult: Boolean;
+Begin
+  TmpResult := False;
+  If (p.typ = ait_instruction) Then
+    Begin
+      Count := 0;
+      Repeat
+        If (TInstr(p).oper[Count].typ = Top_Ref) Then
+          TmpResult := RefsEq(Ref, PInstr(p)^.oper[Count].ref^);
+        Inc(Count);
+      Until (Count = MaxOps) or TmpResult;
+    End;
+  RefInInstruction := TmpResult;
+End;
+
+Function TPaiProp.RefInSequence(Const Ref: TReference; Content: TContent;
+  RefsEq: TRefCompare): Boolean;
+Var p: Tai;
+    Counter: Byte;
+    TmpResult: Boolean;
+Begin
+  p := Content.StartMod;
+  TmpResult := False;
+  Counter := 1;
+  While Not(TmpResult) And
+        (Counter <= Content.NrOfMods) Do
+    Begin
+      If (p.typ = ait_instruction) And
+         RefInInstruction(Ref, p, {$ifdef fpc}@{$endif}RefsEqual)
+        Then TmpResult := True;
+      Inc(Counter);
+      GetNextInstruction(p,p)
+    End;
+  RefInSequence := TmpResult
+End;
+
+{ ************************************************************************* }
+{ ***************************** TAoptObj ********************************** }
+{ ************************************************************************* }
+
+Constructor TAoptObj.Init(_AsmL: TAasmOutput; _BlockStart, _BlockEnd: Tai;
+                            _LabelInfo: PLabelInfo);
+Begin
+  AsmL := _AsmL;
+  BlockStart := _BlockStart;
+  BlockEnd := _BlockEnd;
+  LabelInfo := _LabelInfo
+End;
+
+Function TAOptObj.FindLabel(L: TasmLabel; Var hp: Tai): Boolean;
+Var TempP: Tai;
+Begin
+  TempP := hp;
+  While Assigned(TempP) and
+       (TempP.typ In SkipInstr + [ait_label]) Do
+    If (TempP.typ <> ait_Label) Or
+       (Tai_label(TempP).l <> L)
+      Then GetNextInstruction(TempP, TempP)
+      Else
+        Begin
+          hp := TempP;
+          FindLabel := True;
+          exit
+        End;
+  FindLabel := False;
+End;
+
+Procedure TAOptObj.InsertLLItem(prev, foll, new_one : TLinkedListItem);
+Begin
+  If Assigned(prev) Then
+    If Assigned(foll) Then
+      Begin
+        If Assigned(new_one) Then
+          Begin
+            new_one.previous := prev;
+            new_one.next := foll;
+            prev.next := new_one;
+            foll.previous := new_one;
+            Tai(new_one).fileinfo := Tai(foll).fileinfo
+          End
+      End
+    Else AsmL.Concat(new_one)
+  Else If Assigned(Foll) Then AsmL.Insert(new_one)
+End;
+
+
+Function TAOptObj.SkipHead(P: Tai): Tai;
+Var OldP: Tai;
+Begin
+  Repeat
+    OldP := P;
+    If (P.typ in SkipInstr) Or
+       ((P.typ = ait_marker) And
+        (Tai_Marker(P).Kind = AsmBlockEnd)) Then
+      GetNextInstruction(P, P)
+    Else If ((P.Typ = Ait_Marker) And
+        (Tai_Marker(P).Kind = NoPropInfoStart)) Then
+ { a marker of the type NoPropInfoStart can't be the first instruction of a }
+ { paasmoutput list                                                         }
+      GetNextInstruction(Tai(P.Previous),P);
+    If (P.Typ = Ait_Marker) And
+       (Tai_Marker(P).Kind = AsmBlockStart) Then
+      Begin
+        P := Tai(P.Next);
+        While (P.typ <> Ait_Marker) Or
+              (Tai_Marker(P).Kind <> AsmBlockEnd) Do
+          P := Tai(P.Next)
+      End;
+    Until P = OldP;
+  SkipHead := P;
+End;
+
+Function TAOptObj.OpsEqual(const o1,o2:toper): Boolean;
+Begin
+  if o1.typ=o2.typ then
+    Case o1.typ Of
+      Top_Reg :
+        OpsEqual:=o1.reg=o2.reg;
+      Top_Ref :
+        OpsEqual := RefsEqual(o1.ref^, o2.ref^);
+      Top_Const :
+        OpsEqual:=o1.val=o2.val;
+      Top_Symbol :
+        OpsEqual:=(o1.sym=o2.sym) and (o1.symofs=o2.symofs);
+      Top_None :
+        OpsEqual := True
+      else OpsEqual := False
+    End;
+End;
+
+Function TAOptObj.FindRegAlloc(Reg: TRegister; StartPai: Tai): Boolean;
+Begin
+  FindRegAlloc:=False;
+  Repeat
+    While Assigned(StartPai) And
+          ((StartPai.typ in (SkipInstr - [ait_regAlloc])) Or
+           ((StartPai.typ = ait_label) and
+            Not(Tai_Label(StartPai).l.Is_Used))) Do
+      StartPai := Tai(StartPai.Next);
+    If Assigned(StartPai) And
+       (StartPai.typ = ait_regAlloc) and (TairegAlloc(StartPai).allocation) Then
+      Begin
+        if TairegAlloc(StartPai).Reg = Reg then
+         begin
+           FindRegAlloc:=true;
+           exit;
+         end;
+        StartPai := Tai(StartPai.Next);
+      End
+    else
+      exit;
+  Until false;
+End;
+
+End.
+
+{
+ $Log$
+ Revision 1.1  2001-08-26 13:36:35  florian
+   * some cg reorganisation
+   * some PPC updates
+
+ Revision 1.2  2000/07/14 05:11:49  michael
+ + Patch to 1.1
+
+ Revision 1.1  2000/07/13 06:30:07  michael
+ + Initial import
+
+ Revision 1.8  2000/01/07 01:14:52  peter
+   * updated copyright to 2000
+
+ Revision 1.7  1999/11/09 22:57:08  peter
+   * compiles again both i386,alpha both with optimizer
+
+ Revision 1.6  1999/09/29 13:50:34  jonas
+   * fixes from daopt386.pas integrated
+
+ Revision 1.5  1999/08/26 14:50:52  jonas
+   * fixed small type in TP conditional
+
+ Revision 1.4  1999/08/18 14:32:22  jonas
+   + compilable!
+   + dataflow analyzer finished
+   + start of CSE units
+   + aoptbase which contains a base object for all optimizer objects
+   * some constants and type definitions moved around to avoid circular
+     dependencies
+   * moved some methods from base objects to specialized objects because
+     they're not used anywhere else
+
+ Revision 1.2  1999/08/09 14:07:24  jonas
+ commit.msg
+
+ Revision 1.1  1999/08/08 13:24:50  jonas
+   + added copyright header/GNU license info
+   * made the assembler optimizer almost completely OOP
+   * some code style clean up and extra comments
+   * moved from the new/aopt to the /new and /new/i386 dirs
+
+}

compiler/assemble.pas

@@ -903,9 +903,13 @@ Implementation
                objectalloc.sectionalloc(Tai_string(hp).len);
              ait_instruction :
                begin
+{$ifdef i386}
+{$ifndef NOAG386BIN}
                  { reset instructions which could change in pass 2 }
                  Taicpu(hp).resetpass2;
                  objectalloc.sectionalloc(Taicpu(hp).Pass1(objectalloc.sectionsize));
+{$endif NOAG386BIN}
+{$endif i386}
                end;
              ait_cut :
                if SmartAsm then
@@ -1056,6 +1060,8 @@ Implementation
                objectalloc.sectionalloc(Tai_string(hp).len);
              ait_instruction :
                begin
+{$ifdef i386}
+{$ifndef NOAG386BIN}
                  objectalloc.sectionalloc(Taicpu(hp).Pass1(objectalloc.sectionsize));
                  { fixup the references }
                  for i:=1 to Taicpu(hp).ops do
@@ -1077,6 +1083,8 @@ Implementation
                        end;
                      end;
                   end;
+{$endif NOAG386BIN}
+{$endif i386}
                end;
              ait_direct :
                Message(asmw_f_direct_not_supported);
@@ -1093,9 +1101,9 @@ Implementation
     function TInternalAssembler.TreePass2(hp:Tai):Tai;
       var
         l  : longint;
-{$ifdef I386}
+{$ifdef i386}
         co : comp;
-{$endif I386}
+{$endif i386}
       begin
         { main loop }
         while assigned(hp) do
@@ -1169,12 +1177,14 @@ Implementation
                objectdata.writebytes(Tai_real_32bit(hp).value,4);
              ait_comp_64bit :
                begin
+{$ifdef i386}
 {$ifdef FPC}
                  co:=comp(Tai_comp_64bit(hp).value);
 {$else}
                  co:=Tai_comp_64bit(hp).value;
 {$endif}
                  objectdata.writebytes(co,8);
+{$endif i386}
                end;
              ait_string :
                objectdata.writebytes(Tai_string(hp).str^,Tai_string(hp).len);
@@ -1191,8 +1201,12 @@ Implementation
                    but it's better to be on the safe side (PFV) }
                  objectoutput.exportsymbol(Tai_label(hp).l);
                end;
+{$ifdef i386}
+{$ifndef NOAG386BIN}
              ait_instruction :
                Taicpu(hp).Pass2;
+{$endif NOAG386BIN}
+{$endif i386}
 {$ifdef GDB}
              ait_stabn :
                convertstabs(Tai_stabn(hp).str);
@@ -1520,7 +1534,11 @@ Implementation
 end.
 {
   $Log$
-  Revision 1.23  2001-08-07 18:47:12  peter
+  Revision 1.24  2001-08-26 13:36:35  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.23  2001/08/07 18:47:12  peter
     * merged netbsd start
     * profile for win32
 

compiler/hcodegen.pas → compiler/cgbase.pas

@@ -20,7 +20,7 @@
 
  ****************************************************************************
 }
-unit hcodegen;
+unit cgbase;
 
 {$i defines.inc}
 
@@ -425,7 +425,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.11  2001-08-06 21:40:46  peter
+  Revision 1.1  2001-08-26 13:36:36  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.11  2001/08/06 21:40:46  peter
     * funcret moved from tprocinfo to tprocdef
 
   Revision 1.10  2001/04/13 01:22:07  peter

compiler/cgconst.pas

@@ -0,0 +1,66 @@
+{
+    $Id$
+    Copyright (c) 1998-2001 by Florian Klaempfl
+
+    This units declares some code generator specific constants
+
+    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 cgconst;
+
+  interface
+
+    type
+       TOpCg = (OP_ADD,OP_AND,OP_DIV,OP_IDIV,OP_IMUL,OP_MUL,OP_NEG,OP_NOT,
+                   OP_OR,OP_SAR,OP_SHL,OP_SHR,OP_SUB,OP_XOR);
+
+       TOpCmp = (OC_NONE,OC_EQ,OC_GT,OC_LT,OC_GTE,OC_LTE,OC_NE,OC_BE,OC_B,
+                 OC_AE,OC_A);
+
+       TCgSize = (OS_NO,OS_8,OS_16,OS_32,OS_64);
+
+    const
+       { defines the default address size for a processor }
+       { and defines the natural int size for a processor }
+{$ifdef i386}
+       OS_ADDR = OS_32;
+       OS_INT = OS_32;
+{$endif i386}
+{$ifdef alpha}
+       OS_ADDR = OS_64;
+       OS_INT = OS_64;
+{$endif alpha}
+{$ifdef powerpc}
+       OS_ADDR = OS_32;
+       OS_INT = OS_32;
+{$endif powercc}
+{$ifdef ia64}
+       OS_ADDR = OS_64;
+       OS_INT = OS_64;
+{$endif ia64}
+
+  implementation
+
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-08-26 13:36:37  florian
+    * some cg reorganisation
+    * some PPC updates
+
+}

compiler/cgobj.pas

@@ -0,0 +1,1364 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Florian Klaempfl
+    Member of the Free Pascal development team
+
+    This unit implements the basic code generator object
+
+    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 cgobj;
+
+  interface
+
+    uses
+       cclasses,aasm,cpuasm,cpubase,cpuinfo,
+       cgconst,cgbase,
+       tainst,
+       symtable,symconst,symbase,symtype,symsym;
+
+    type
+       talignment = (AM_NATURAL,AM_NONE,AM_2BYTE,AM_4BYTE,AM_8BYTE);
+
+       pcg = ^tcg;
+       tcg = object
+          scratch_register_array_pointer : aword;
+          unusedscratchregisters : tregisterset;
+
+          alignment : talignment;
+          {************************************************}
+          {                 basic routines                 }
+          constructor init;
+          destructor done;virtual;
+
+          procedure a_label(list : taasmoutput;l : tasmlabel);virtual;
+
+          { allocates register r by inserting a pai_realloc record }
+          procedure a_reg_alloc(list : taasmoutput;r : tregister);
+          { deallocates register r by inserting a pa_regdealloc record}
+          procedure a_reg_dealloc(list : taasmoutput;r : tregister);
+
+          { returns a register for use as scratch register }
+          function get_scratch_reg(list : taasmoutput) : tregister;
+          { releases a scratch register }
+          procedure free_scratch_reg(list : taasmoutput;r : tregister);
+
+          {************************************************}
+          { code generation for subroutine entry/exit code }
+
+          { initilizes data of type t                           }
+          { if is_already_ref is true then the routines assumes }
+          { that r points to the data to initialize             }
+          procedure g_initialize(list : taasmoutput;t : tdef;const ref : treference;is_already_ref : boolean);
+
+          { finalizes data of type t                            }
+          { if is_already_ref is true then the routines assumes }
+          { that r points to the data to finalizes              }
+          procedure g_finalize(list : taasmoutput;t : tdef;const ref : treference;is_already_ref : boolean);
+
+          { helper routines }
+          procedure g_initialize_data(list : taasmoutput;p : tsym);
+          procedure g_incr_data(list : taasmoutput;p : tsym);
+          procedure g_finalize_data(list : taasmoutput;p : tindexarray);
+          procedure g_copyvalueparas(list : taasmoutput;p : tindexarray);
+          procedure g_finalizetempansistrings(list : taasmoutput);
+
+          procedure g_entrycode(list : taasmoutput;
+            const proc_names : tstringlist;make_global : boolean;
+            stackframe : longint;var parasize : longint;
+            var nostackframe : boolean;inlined : boolean);
+
+          procedure g_exitcode(list : taasmoutput;parasize : longint;
+            nostackframe,inlined : boolean);
+
+          { string helper routines }
+          procedure g_decrstrref(list : taasmoutput;const ref : treference;t : tdef);
+
+          procedure g_removetemps(list : taasmoutput;p : tlinkedlist);
+
+          { 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_reg(list : taasmoutput;size : tcgsize;r : tregister;nr : longint);virtual;
+          procedure a_param_const(list : taasmoutput;size : tcgsize;a : aword;nr : longint);virtual;
+          procedure a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;nr : longint);virtual;
+          procedure a_paramaddr_ref(list : taasmoutput;const r : treference;nr : longint);virtual;
+
+          {**********************************}
+          { these methods must be overriden: }
+
+          { Remarks:
+            * If a method specifies a size you have only to take care
+              of that number of bits, i.e. load_const_reg with OP_8 must
+              only load the lower 8 bit of the specified register
+              the rest of the register can be undefined
+              if  necessary the compiler will call a method
+              to zero or sign extend the register
+            * The a_load_XX_XX with OP_64 needn't to be
+              implemented for 32 bit
+              processors, the code generator takes care of that
+            * the addr size is for work with the natural pointer
+              size
+            * the procedures without fpu/mm are only for integer usage
+            * normally the first location is the source and the
+              second the destination
+          }
+
+          procedure a_call_name(list : taasmoutput;const s : string;
+            offset : longint);virtual;
+
+          { move instructions }
+          procedure a_load_const_reg(list : taasmoutput;size : tcgsize;a : aword;register : tregister);virtual;
+          procedure a_load_const_ref(list : taasmoutput;size : tcgsize;a : aword;const ref : treference);virtual;
+          procedure a_load_reg_ref(list : taasmoutput;size : tcgsize;register : tregister;const ref : treference);virtual;
+          procedure a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref : treference;register : tregister);virtual;
+          procedure a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister);virtual;
+
+          {  comparison operations }
+          procedure a_cmp_reg_const_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
+            l : tasmlabel);virtual;
+          procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel);
+          procedure a_cmp_reg_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg : tregister;l : tasmlabel);
+          procedure a_cmp_ref_const_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
+            l : tasmlabel);
+
+          procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
+
+          procedure a_loadaddress_ref_reg(list : taasmoutput;const ref : treference;r : tregister);virtual;
+          procedure g_stackframe_entry(list : taasmoutput;localsize : longint);virtual;
+          { restores the frame pointer at procedure exit, for the }
+          { i386 it generates a simple leave                      }
+          procedure g_restore_frame_pointer(list : taasmoutput);virtual;
+
+          { some processors like the PPC doesn't allow to change the stack in }
+          { a procedure, so we need to maintain an extra stack for the        }
+          { result values of setjmp in exception code                         }
+          { this two procedures are for pushing an exception value,           }
+          { they can use the scratch registers                                }
+          procedure g_push_exception_value_reg(list : taasmoutput;reg : tregister);virtual;
+          procedure g_push_exception_value_const(list : taasmoutput;reg : tregister);virtual;
+          { that procedure pops a exception value                             }
+          procedure g_pop_exception_value_reg(list : taasmoutput;reg : tregister);virtual;
+          procedure g_return_from_proc(list : taasmoutput;parasize : aword);virtual;
+          {********************************************************}
+          { these methods can be overriden for extra functionality }
+
+          { the following methods do nothing: }
+          procedure g_interrupt_stackframe_entry(list : taasmoutput);virtual;
+          procedure g_interrupt_stackframe_exit(list : taasmoutput);virtual;
+
+          procedure g_profilecode(list : taasmoutput);virtual;
+          procedure g_stackcheck(list : taasmoutput;stackframesize : longint);virtual;
+
+          procedure g_maybe_loadself(list : taasmoutput);virtual;
+          { copies len bytes from the source to destination, if }
+          { loadref is true, it assumes that it first must load }
+          { the source address from the memory location where   }
+          { source points to                                    }
+          procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword;loadref : boolean);virtual;
+
+          { uses the addr of ref as param, was emitpushreferenceaddr }
+          procedure a_param_ref_addr(list : taasmoutput;r : treference;nr : longint);virtual;
+       end;
+
+    var
+       cg : pcg; { this is the main code generator class }
+
+  implementation
+
+    uses
+       strings,globals,globtype,options,gdb,systems,
+       ppu,verbose,types,temp_gen,tgcpu;
+
+{*****************************************************************************
+                            basic functionallity
+******************************************************************************}
+
+    constructor tcg.init;
+
+      var
+         i : longint;
+
+      begin
+         scratch_register_array_pointer:=1;
+         for i:=1 to max_scratch_regs do
+           include(unusedscratchregisters,scratch_regs[i]);
+      end;
+
+    destructor tcg.done;
+
+      begin
+      end;
+
+    procedure tcg.a_reg_alloc(list : taasmoutput;r : tregister);
+
+      begin
+         list.concat(tairegalloc.alloc(r));
+      end;
+
+    procedure tcg.a_reg_dealloc(list : taasmoutput;r : tregister);
+
+      begin
+         list.concat(tairegalloc.dealloc(r));
+      end;
+
+    procedure tcg.a_label(list : taasmoutput;l : tasmlabel);
+
+      begin
+         list.concat(tai_label.create(l));
+      end;
+
+    function tcg.get_scratch_reg(list : taasmoutput) : tregister;
+
+      var
+         r : tregister;
+         i : longint;
+
+      begin
+         if unusedscratchregisters=[] then
+           internalerror(68996);
+
+         for i:=scratch_register_array_pointer to
+                (scratch_register_array_pointer+max_scratch_regs) do
+           if scratch_regs[(i mod max_scratch_regs)+1] in unusedscratchregisters then
+             begin
+                r:=scratch_regs[(i mod max_scratch_regs)+1];
+                break;
+             end;
+         exclude(unusedscratchregisters,r);
+         inc(scratch_register_array_pointer);
+         if scratch_register_array_pointer>max_scratch_regs then
+           scratch_register_array_pointer:=1;
+         a_reg_alloc(list,r);
+         get_scratch_reg:=r;
+      end;
+
+    procedure tcg.free_scratch_reg(list : taasmoutput;r : tregister);
+
+      begin
+         include(unusedscratchregisters,r);
+         a_reg_dealloc(list,r);
+      end;
+
+{*****************************************************************************
+            this methods must be overridden for extra functionality
+******************************************************************************}
+
+    procedure tcg.g_interrupt_stackframe_entry(list : taasmoutput);
+
+      begin
+      end;
+
+    procedure tcg.g_interrupt_stackframe_exit(list : taasmoutput);
+
+      begin
+      end;
+
+    procedure tcg.g_profilecode(list : taasmoutput);
+
+      begin
+      end;
+
+{*****************************************************************************
+          for better code generation these methods should be overridden
+******************************************************************************}
+
+    procedure tcg.a_param_const(list : taasmoutput;size : tcgsize;a : aword;nr : longint);
+
+      var
+         hr : tregister;
+
+      begin
+         hr:=get_scratch_reg(list);
+         a_load_const_reg(list,size,a,hr);
+         a_param_reg(list,size,hr,nr);
+         free_scratch_reg(list,hr);
+      end;
+
+    procedure tcg.a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;nr : longint);
+
+      var
+         hr : tregister;
+
+      begin
+         hr:=get_scratch_reg(list);
+         a_load_ref_reg(list,size,r,hr);
+         a_param_reg(list,size,hr,nr);
+         free_scratch_reg(list,hr);
+      end;
+
+    procedure tcg.a_param_ref_addr(list : taasmoutput;r : treference;nr : longint);
+
+      var
+         hr : tregister;
+
+      begin
+         hr:=get_scratch_reg(list);
+         a_loadaddress_ref_reg(list,r,hr);
+         a_param_reg(list,OS_ADDR,hr,nr);
+         free_scratch_reg(list,hr);
+      end;
+
+    procedure tcg.g_stackcheck(list : taasmoutput;stackframesize : longint);
+
+      begin
+         a_param_const(list,OS_32,stackframesize,1);
+         a_call_name(list,'FPC_STACKCHECK',0);
+      end;
+
+    procedure tcg.a_load_const_ref(list : taasmoutput;size : tcgsize;a : aword;const ref : treference);
+
+      var
+         hr : tregister;
+
+      begin
+         hr:=get_scratch_reg(list);
+         a_load_const_reg(list,size,a,hr);
+         a_load_reg_ref(list,size,hr,ref);
+         free_scratch_reg(list,hr);
+      end;
+
+
+    procedure tcg.g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword;loadref : boolean);
+
+      begin
+         abstract;
+      end;
+
+
+{*****************************************************************************
+                         String helper routines
+*****************************************************************************}
+
+    procedure tcg.g_removetemps(list : taasmoutput;p : tlinkedlist);
+
+      var
+         hp : ptemptodestroy;
+         pushedregs : tpushed;
+
+      begin
+         hp:=ttemptodestroy(p.first);
+         if not(assigned(hp)) then
+           exit;
+         pushusedregisters(pushedregs,$ff);
+         while assigned(hp) do
+           begin
+              if is_ansistring(hp^.typ) then
+                begin
+                   g_decrstrref(list,hp.address,hp^.typ);
+                   ungetiftemp(hp^.address);
+                end;
+              hp:=ptemptodestroy(hp^.next);
+           end;
+         popusedregisters(pushedregs);
+      end;
+
+    procedure tcg.g_decrstrref(list : taasmoutput;const ref : treference;t : tdef);
+
+      var
+         pushedregs : tpushed;
+
+      begin
+         pushusedregisters(pushedregs,$ff);
+         a_param_ref_addr(list,ref,1);
+         if is_ansistring(t) then
+           a_call_name(list,'FPC_ANSISTR_DECR_REF',0)
+         else if is_widestring(t) then
+           a_call_name(list,'FPC_WIDESTR_DECR_REF',0)
+         else internalerror(58993);
+         popusedregisters(pushedregs);
+      end;
+
+{*****************************************************************************
+                  Code generation for subroutine entry- and exit code
+ *****************************************************************************}
+
+    { initilizes data of type t                           }
+    { if is_already_ref is true then the routines assumes }
+    { that r points to the data to initialize             }
+    procedure tcg.g_initialize(list : taasmoutput;t : tdef;const ref : treference;is_already_ref : boolean);
+
+      var
+         hr : treference;
+
+      begin
+         if is_ansistring(t) or
+           is_widestring(t) then
+           a_load_const_ref(list,OS_8,0,ref)
+         else
+           begin
+              reset_reference(hr);
+              hr.symbol:=t^.get_inittable_label;
+              a_param_ref_addr(list,hr,2);
+              if is_already_ref then
+                a_param_ref(list,OS_ADDR,ref,1)
+              else
+                a_param_ref_addr(list,ref,1);
+              a_call_name(list,'FPC_INITIALIZE',0);
+           end;
+      end;
+
+    procedure tcg.g_finalize(list : taasmoutput;t : tdef;const ref : treference;is_already_ref : boolean);
+
+      var
+         r : treference;
+
+      begin
+         if is_ansistring(t) or
+           is_widestring(t) then
+           begin
+              g_decrstrref(list,ref,t);
+           end
+         else
+           begin
+              reset_reference(r);
+              r.symbol:=t^.get_inittable_label;
+              a_param_ref_addr(list,r,2);
+              if is_already_ref then
+                a_paramaddr_ref(list,ref,1)
+              else
+                a_param_ref_addr(list,ref,1);
+              a_call_name(list,'FPC_FINALIZE',0);
+           end;
+      end;
+
+    { generates the code for initialisation of local data }
+    procedure tcg.g_initialize_data(list : taasmoutput;p : tsym);
+
+      var
+         hr : treference;
+
+      begin
+         if (tsym(p).typ=varsym) and
+            assigned(tvarsym(p).vartype.def) and
+            not((tvarsym(p).vartype.def^.deftype=objectdef) and
+              tobjectdef(tvarsym(p).vartype.def)^.is_class) and
+            tvarsym(p).vartype.def.needs_inittable then
+           begin
+              procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
+              reset_reference(hr);
+              if tsym(p)^.owner^.symtabletype=localsymtable then
+                begin
+                   hr.base:=procinfo^.framepointer;
+                   hr.offset:=-tvarsym(p)^.address;
+                end
+              else
+                begin
+                   hr.symbol:=newasmsymbol(tvarsym(p)^.mangledname);
+                end;
+              g_initialize(list,tvarsym(p)^.vartype.def,hr,false);
+           end;
+      end;
+
+
+    { generates the code for incrementing the reference count of parameters }
+    procedure tcg.g_incr_data(list : taasmoutput;p : tsym);
+
+      var
+         hr : treference;
+
+      begin
+         if (tsym(p).typ=varsym) and
+            not((tvarsym(p).vartype.def.deftype=objectdef) and
+              tobjectdef(tvarsym(p).vartype.def).is_class) and
+            tvarsym(p).vartype.def.needs_inittable and
+            ((tvarsym(p).varspez=vs_value)) then
+           begin
+              procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
+              reset_reference(hr);
+              hr.symbol:=tvarsym(p)^.vartype.def^.get_inittable_label;
+              a_param_ref_addr(list,hr,2);
+              reset_reference(hr);
+              hr.base:=procinfo^.framepointer;
+              hr.offset:=tvarsym(p)^.address+procinfo^.para_offset;
+              a_param_ref_addr(list,hr,1);
+              reset_reference(hr);
+              a_call_name(list,'FPC_ADDREF',0);
+           end;
+      end;
+
+
+    { generates the code for finalisation of local data }
+    procedure tcg.g_finalize_data(list : taasmoutput;p : tnamedindex);
+
+      var
+         hr : treference;
+
+      begin
+         if (tsym(p).typ=varsym) and
+            assigned(tvarsym(p).vartype.def) and
+            not((tvarsym(p).vartype.def.deftype=objectdef) and
+            tobjectdef(tvarsym(p).vartype.def).is_class) and
+            tvarsym(p).vartype.def.needs_inittable then
+           begin
+              { not all kind of parameters need to be finalized  }
+              if (tsym(p).owner.symtabletype=parasymtable) and
+                ((tvarsym(p).varspez=vs_var)  or
+                 (tvarsym(p).varspez=vs_const) { and
+                 (dont_copy_const_param(tvarsym(p)^.definition)) } ) then
+                exit;
+              procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
+              reset_reference(hr);
+              case tsym(p).owner^.symtabletype of
+                 localsymtable:
+                   begin
+                      hr.base:=procinfo^.framepointer;
+                      hr.offset:=-tvarsym(p).address;
+                   end;
+                 parasymtable:
+                   begin
+                      hr.base:=procinfo^.framepointer;
+                      hr.offset:=tvarsym(p).address+procinfo^.para_offset;
+                   end;
+                 else
+                   hr.symbol:=newasmsymbol(tvarsym(p).mangledname);
+              end;
+              g_finalize(list,tvarsym(p).vartype.def,hr,false);
+           end;
+      end;
+
+
+    { generates the code to make local copies of the value parameters }
+    procedure tcg.g_copyvalueparas(list : taasmoutput;p : pnamedindexobject);
+      begin
+         runerror(255);
+      end;
+
+    var
+       _list : taasmoutput;
+
+    { wrappers for the methods, because TP doesn't know procedures }
+    { of objects                                                   }
+
+    {$IFNDEF NEWST}
+    procedure _copyvalueparas(s : pnamedindexobject);{$ifndef FPC}far;{$endif}
+
+      begin
+         cg^.g_copyvalueparas(_list,s);
+      end;
+    {$ENDIF NEWST}
+
+    procedure tcg.g_finalizetempansistrings(list : taasmoutput);
+
+      var
+         hp : ptemprecord;
+         hr : treference;
+
+      begin
+         hp:=templist;
+         while assigned(hp) do
+           begin
+              if hp^.temptype in [tt_ansistring,tt_freeansistring] then
+                begin
+                   procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
+                   reset_reference(hr);
+                   hr.base:=procinfo^.framepointer;
+                   hr.offset:=hp^.pos;
+                   a_param_ref_addr(list,hr,1);
+                   a_call_name(list,'FPC_ANSISTR_DECR_REF',0);
+                end;
+              hp:=hp^.next;
+           end;
+     end;
+
+    procedure _finalize_data(s : pnamedindexobject);{$ifndef FPC}far;{$endif}
+
+      begin
+         cg^.g_finalize_data(_list,s);
+      end;
+
+    procedure _incr_data(s : pnamedindexobject);{$ifndef FPC}far;{$endif}
+
+      begin
+         cg^.g_incr_data(_list,tsym(s));
+      end;
+
+    procedure _initialize_data(s : pnamedindexobject);{$ifndef FPC}far;{$endif}
+
+      begin
+         cg^.g_initialize_data(_list,tsym(s));
+      end;
+
+    { generates the entry code for a procedure }
+    procedure tcg.g_entrycode(list : taasmoutput;const proc_names:Tstringcontainer;make_global:boolean;
+       stackframe:longint;var parasize:longint;var nostackframe:boolean;
+       inlined : boolean);
+
+      var
+         hs : string;
+         hp : pused_unit;
+         initcode : taasmoutput;
+{$ifdef GDB}
+         stab_function_name : Pai_stab_function_name;
+{$endif GDB}
+         hr : treference;
+         r : tregister;
+
+      begin
+         { Align }
+         if (not inlined) then
+           begin
+              { gprof uses 16 byte granularity !! }
+              if (cs_profile in aktmoduleswitches) then
+                list^.insert(new(pai_align,init(16)))
+              else
+                if not(cs_littlesize in aktglobalswitches) then
+                  list^.insert(new(pai_align,init(4)));
+          end;
+         { save registers on cdecl }
+         {$IFDEF NEWST}
+         if (posavestdregs in aktprocdef^.options) then
+         {$ELSE}
+         if (po_savestdregs in aktprocsym^.definition^.procoptions) then
+         {$ENDIF NEWST}
+           begin
+              for r:=firstreg to lastreg do
+                begin
+                   if (r in registers_saved_on_cdecl) then
+                     if (r in (tg.availabletempregsint+
+                               tg.availabletempregsfpu+
+                               tg.availabletempregsmm)) then
+                       begin
+                          if not(r in tg.usedinproc) then
+                            {!!!!!!!!!!!! a_push_reg(list,r) }
+                       end
+                     else
+                       {!!!!!!!! a_push_reg(list,r) };
+                end;
+           end;
+        { omit stack frame ? }
+        if not inlined then
+          if procinfo^.framepointer=stack_pointer then
+            begin
+               CGMessage(cg_d_stackframe_omited);
+               nostackframe:=true;
+            {$IFDEF NEWST}
+               if (aktprocdef^.proctype in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
+                 parasize:=0
+               else
+                 parasize:=aktprocdef^.localst^.paramdatasize+procinfo^.para_offset-pointersize;
+            {$ELSE}
+               if (aktprocsym^.definition^.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
+                 parasize:=0
+               else
+                 parasize:=aktprocsym^.definition^.parast^.datasize+procinfo^.para_offset-pointersize;
+            {$ENDIF NEWST}
+            end
+          else
+            begin
+            {$IFDEF NEWST}
+               if (aktprocdef^.proctype in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
+                 parasize:=0
+               else
+                 parasize:=aktprocdef^.localst^.paramdatasize+procinfo^.para_offset-pointersize*2;
+            {$ELSE}
+               if (aktprocsym^.definition^.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
+                 parasize:=0
+               else
+                 parasize:=aktprocsym^.definition^.parast^.datasize+procinfo^.para_offset-pointersize*2;
+            {$ENDIF}
+               nostackframe:=false;
+            {$IFDEF NEWST}
+               if (pointerrupt in aktprocdef^.options) then
+                 g_interrupt_stackframe_entry(list);
+            {$ELSE}
+               if (po_interrupt in aktprocsym^.definition^.procoptions) then
+                 g_interrupt_stackframe_entry(list);
+            {$ENDIF NEWST}
+
+               g_stackframe_entry(list,stackframe);
+
+               if (cs_check_stack in aktlocalswitches) and
+                 (tf_supports_stack_checking in target_info.flags) then
+                 g_stackcheck(@initcode,stackframe);
+            end;
+
+         if cs_profile in aktmoduleswitches then
+           g_profilecode(@initcode);
+         {$IFDEF NEWST}
+          if (not inlined) and (aktprocdef^.proctype in [potype_unitinit]) then
+         {$ELSE}
+          if (not inlined) and (aktprocsym^.definition^.proctypeoption in [potype_unitinit]) then
+         {$ENDIF NEWST}
+            begin
+
+              { needs the target a console flags ? }
+              if tf_needs_isconsole in target_info.flags then
+                begin
+                   hr.symbol:=newasmsymbol('U_'+target_info.system_unit+'_ISCONSOLE');
+                   if apptype=at_cui then
+                     a_load_const_ref(list,OS_8,1,hr)
+                   else
+                     a_load_const_ref(list,OS_8,0,hr);
+                   dispose(hr.symbol,done);
+                end;
+
+              hp:=pused_unit(usedunits.first);
+              while assigned(hp) do
+                begin
+                   { call the unit init code and make it external }
+                   if (hp^.u^.flags and uf_init)<>0 then
+                     a_call_name(list,
+                       'INIT$$'+hp^.u^.modulename^,0);
+                    hp:=Pused_unit(hp^.next);
+                end;
+           end;
+
+{$ifdef dummy}
+         { a constructor needs a help procedure }
+         if (aktprocsym^.definition^.options and poconstructor)<>0 then
+           begin
+             if procinfo^._class^.isclass then
+               begin
+                 list^.concat(new(paicpu,op_sym(A_CALL,S_NO,newasmsymbol('FPC_NEW_CLASS'))));
+                 list^.concat(new(paicpu,op_cond_sym(A_Jcc,C_Z,S_NO,quickexitlabel)));
+               end
+             else
+               begin
+                 {
+                 list^.insert(new(pai_labeled,init(A_JZ,quickexitlabel)));
+                 list^.insert(new(paicpu,op_csymbol(A_CALL,S_NO,
+                   newcsymbol('FPC_HELP_CONSTRUCTOR',0))));
+                 list^.insert(new(paicpu,op_const_reg(A_MOV,S_L,procinfo^._class^.vmt_offset,R_EDI)));
+                 concat_external('FPC_HELP_CONSTRUCTOR',EXT_NEAR);
+                 }
+               end;
+           end;
+{$endif dummy}
+  {$ifdef GDB}
+         if (cs_debuginfo in aktmoduleswitches) then
+           list^.insert(new(pai_force_line,init));
+  {$endif GDB}
+
+        {$IFDEF NEWST}
+         { initialize return value }
+         if assigned(procinfo^.retdef) and
+           is_ansistring(procinfo^.retdef) or
+           is_widestring(procinfo^.retdef) then
+           begin
+              reset_reference(hr);
+              hr.offset:=procinfo^.return_offset;
+              hr.base:=procinfo^.framepointer;
+              a_load_const_ref(list,OS_32,0,hr);
+           end;
+        {$ELSE}
+         { initialize return value }
+         if assigned(procinfo^.returntype.def) and
+           is_ansistring(procinfo^.returntype.def) or
+           is_widestring(procinfo^.returntype.def) then
+           begin
+              reset_reference(hr);
+              hr.offset:=procinfo^.return_offset;
+              hr.base:=procinfo^.framepointer;
+              a_load_const_ref(list,OS_32,0,hr);
+           end;
+        {$ENDIF}
+
+         _list:=list;
+         { generate copies of call by value parameters }
+        {$IFDEF NEWST}
+         if (poassembler in aktprocdef^.options) then
+            aktprocdef^.parameters^.foreach(@_copyvalueparas);
+        {$ELSE}
+         if (po_assembler in aktprocsym^.definition^.procoptions) then
+            aktprocsym^.definition^.parast^.foreach({$ifdef FPC}@{$endif FPC}_copyvalueparas);
+        {$ENDIF NEWST}
+
+        {$IFDEF NEWST}
+         { initialisizes local data }
+         aktprocdef^.localst^.foreach({$ifdef FPC}@{$endif FPC}_initialize_local);
+        {$ELSE}
+         { initialisizes local data }
+         aktprocsym^.definition^.localst^.foreach({$ifdef FPC}@{$endif FPC}_initialize_data);
+         { add a reference to all call by value/const parameters }
+         aktprocsym^.definition^.parast^.foreach({$ifdef FPC}@{$endif FPC}_incr_data);
+        {$ENDIF NEWST}
+
+        {$IFDEF NEWST}
+         if (cs_profile in aktmoduleswitches) or
+           (typeof(aktprocdef^.owner^)=typeof(Tglobalsymtable)) or
+           (typeof(aktprocdef^.owner^)=typeof(Timplsymtable)) or
+           (assigned(procinfo^._class) and
+           (typeof(procinfo^._class^.owner^)=typeof(Tglobalsymtable)) or
+           (typeof(procinfo^._class^.owner^)=typeof(Timplsymtable))) then
+           make_global:=true;
+        {$ELSE}
+         if (cs_profile in aktmoduleswitches) or
+           (aktprocsym^.definition^.owner^.symtabletype=globalsymtable) or
+           (assigned(procinfo^._class) and (procinfo^._class^.owner^.symtabletype=globalsymtable)) then
+           make_global:=true;
+        {$ENDIF NEWST}
+         if not inlined then
+           begin
+              hs:=proc_names.get;
+
+  {$ifdef GDB}
+              if (cs_debuginfo in aktmoduleswitches) and target_os.use_function_relative_addresses then
+                stab_function_name := new(pai_stab_function_name,init(strpnew(hs)));
+  {$endif GDB}
+
+              { insert the names for the procedure }
+              while hs<>'' do
+                begin
+                   if make_global then
+                     exprasmlist^.insert(new(pai_symbol,initname_global(hs,0)))
+                   else
+                     exprasmlist^.insert(new(pai_symbol,initname(hs,0)));
+
+  {$ifdef GDB}
+                   if (cs_debuginfo in aktmoduleswitches) then
+                     begin
+                       if target_os.use_function_relative_addresses then
+                         list^.insert(new(pai_stab_function_name,init(strpnew(hs))));
+                    end;
+  {$endif GDB}
+
+                  hs:=proc_names.get;
+               end;
+          end;
+
+  {$ifdef GDB}
+         if (not inlined) and (cs_debuginfo in aktmoduleswitches) then
+           begin
+              if target_os.use_function_relative_addresses then
+                  list^.insert(stab_function_name);
+              if make_global or ((procinfo^.flags and pi_is_global) <> 0) then
+                  aktprocsym^.is_global := True;
+              list^.insert(new(pai_stabs,init(aktprocsym^.stabstring)));
+              aktprocsym^.isstabwritten:=true;
+            end;
+  {$endif GDB}
+    end;
+
+    procedure tcg.g_exitcode(list : taasmoutput;parasize:longint;nostackframe,inlined:boolean);
+
+      var
+  {$ifdef GDB}
+         mangled_length : longint;
+         p : pchar;
+  {$endif GDB}
+         nofinal,noreraiselabel : tasmlabel;
+         hr : treference;
+         r : tregister;
+
+      begin
+         if aktexitlabel^.is_used then
+           list^.insert(new(pai_label,init(aktexitlabel)));
+
+         { call the destructor help procedure }
+         {$IFDEF NEWST}
+         if (aktprocdef^.proctype=potype_destructor) then
+         {$ELSE}
+         if (aktprocsym^.definition^.proctypeoption=potype_destructor) then
+         {$ENDIF}
+           begin
+           {$IFDEF NEWST}
+             if oo_is_class in procinfo^._class^.options then
+           {$ELSE NEWST}
+             if procinfo^._class^.is_class then
+           {$ENDIF}
+               a_call_name(list,'FPC_DISPOSE_CLASS',0)
+             else
+               begin
+                  if procinfo^._class^.needs_inittable then
+                    begin
+                       getlabel(nofinal);
+                       {!!!!!!!!!!
+                       reset_reference(hr);
+                       hr.base:=R_EBP;
+                       hr.offset:=8;
+                       a_cmp_reg_const_label(list,OS_ADDR,OZ_EQ,
+                       }
+                       reset_reference(hr);
+                       hr.symbol:=procinfo^._class^.get_inittable_label;
+                       a_paramaddr_ref(list,hr,2);
+                       a_param_reg(list,OS_ADDR,self_pointer,1);
+                       a_call_name(list,'FPC_FINALIZE',0);
+                       a_label(list,nofinal);
+                    end;
+                  { vmt_offset_reg can be a scratch register, }
+                  { but it must be always the same            }
+                  a_reg_alloc(list,vmt_offset_reg);
+                  a_load_const_reg(list,OS_32,procinfo^._class^.vmt_offset,vmt_offset_reg);
+                  a_call_name(list,'FPC_HELP_DESTRUCTOR',0);
+                  a_reg_dealloc(list,vmt_offset_reg);
+               end;
+           end;
+
+         { finalize temporary data }
+         g_finalizetempansistrings(list);
+
+         _list:=list;
+
+         { finalize local data }
+         {$IFDEF NEWST}
+         aktprocdef^.localst^.foreach({$ifndef TP}@{$endif}_finalize_data);
+         {$ELSE}
+         aktprocsym^.definition^.localst^.foreach({$ifndef TP}@{$endif}_finalize_data);
+         {$ENDIF}
+
+         {$IFNDEF NEWST}
+         { finalize paras data }
+         if assigned(aktprocsym^.definition^.parast) then
+           aktprocsym^.definition^.parast^.foreach({$ifndef TP}@{$endif}_finalize_data);
+         {$ENDIF NEWST}
+
+         { do we need to handle exceptions because of ansi/widestrings ? }
+         if (procinfo^.flags and pi_needs_implicit_finally)<>0 then
+           begin
+              getlabel(noreraiselabel);
+
+              a_call_name(list,'FPC_POPADDRSTACK',0);
+              a_reg_alloc(list,accumulator);
+              g_pop_exception_value_reg(list,accumulator);
+              a_cmp_reg_const_label(list,OS_32,OC_EQ,0,accumulator,noreraiselabel);
+              a_reg_dealloc(list,accumulator);
+
+           {$IFDEF NEWST}
+              { must be the return value finalized before reraising the exception? }
+              if (procinfo^.retdef<>tdef(voiddef)) and
+                (procinfo^.retdef^.needs_inittable) and
+                ((typeof(procinfo^.retdef^)<>typeof(Tobjectdef)) or
+                not(oo_is_class in pobjectdef(procinfo^.retdef)^.options)) then
+                begin
+                   reset_reference(hr);
+                   hr.offset:=procinfo^.return_offset;
+                   hr.base:=procinfo^.framepointer;
+                   g_finalize(list,procinfo^.retdef,hr,not (dp_ret_in_acc in procinfo^.retdef^.properties));
+                end;
+           {$ELSE}
+              { must be the return value finalized before reraising the exception? }
+              if (procinfo^.returntype.def<>tdef(voiddef)) and
+                (procinfo^.returntype.def^.needs_inittable) and
+                ((procinfo^.returntype.def^.deftype<>objectdef) or
+                not(pobjectdef(procinfo^.returntype.def)^.is_class)) then
+                begin
+                   reset_reference(hr);
+                   hr.offset:=procinfo^.return_offset;
+                   hr.base:=procinfo^.framepointer;
+                   g_finalize(list,procinfo^.returntype.def,hr,ret_in_param(procinfo^.returntype.def));
+                end;
+           {$ENDIF}
+
+              a_call_name(list,'FPC_RERAISE',0);
+              a_label(list,noreraiselabel);
+           end;
+
+         { call __EXIT for main program }
+      {$IFDEF NEWST}
+         if (not DLLsource) and (not inlined) and (aktprocdef^.proctype=potype_proginit) then
+           a_call_name(list,'FPC_DO_EXIT',0);
+      {$ELSE}
+         if (not DLLsource) and (not inlined) and (aktprocsym^.definition^.proctypeoption=potype_proginit) then
+           a_call_name(list,'FPC_DO_EXIT',0);
+      {$ENDIF NEWST}
+
+         { handle return value }
+      {$IFDEF NEWST}
+         if not(poassembler in aktprocdef^.options) then
+             if (aktprocdef^.proctype<>potype_constructor) then
+      {$ELSE}
+         if not(po_assembler in aktprocsym^.definition^.procoptions) then
+             if (aktprocsym^.definition^.proctypeoption<>potype_constructor) then
+      {$ENDIF NEWST}
+               { handle_return_value(inlined) }
+             else
+               begin
+                  { return self in EAX }
+                  a_label(list,quickexitlabel);
+                  a_reg_alloc(list,accumulator);
+                  a_load_reg_reg(list,OS_ADDR,self_pointer,accumulator);
+                  a_reg_dealloc(list,self_pointer);
+                  a_label(list,quickexitlabel);
+                  { we can't clear the zero flag because the Alpha     }
+                  { for example doesn't have flags, we have to compare }
+                  { the accu. in the caller                            }
+               end;
+
+         { stabs uses the label also ! }
+         if aktexit2label^.is_used or
+            ((cs_debuginfo in aktmoduleswitches) and not inlined) then
+           a_label(list,aktexit2label);
+
+{$ifdef dummy}
+         { should we restore edi ? }
+         { for all i386 gcc implementations }
+         {!!!!!!!!!!! I don't know how to handle register saving yet }
+         if (po_savestdregs in aktprocsym^.definition^.procoptions) then
+           begin
+             if (aktprocsym^.definition^.usedregisters and ($80 shr byte(R_EBX)))<>0 then
+              exprasmlist^.concat(new(paicpu,op_reg(A_POP,S_L,R_EBX)));
+             exprasmlist^.concat(new(paicpu,op_reg(A_POP,S_L,R_ESI)));
+             exprasmlist^.concat(new(paicpu,op_reg(A_POP,S_L,R_EDI)));
+             { here we could reset R_EBX
+               but that is risky because it only works
+               if genexitcode is called after genentrycode
+               so lets skip this for the moment PM
+             aktprocsym^.definition^.usedregisters:=
+               aktprocsym^.definition^.usedregisters or not ($80 shr byte(R_EBX));
+             }
+           end;
+{$endif dummy}
+         if not(nostackframe) and not inlined then
+           g_restore_frame_pointer(list);
+         { at last, the return is generated }
+
+         if not inlined then
+         {$IFDEF NEWST}
+           if pointerrupt in aktprocdef^.options then
+         {$ELSE}
+           if po_interrupt in aktprocsym^.definition^.procoptions then
+         {$ENDIF NEWST}
+             g_interrupt_stackframe_exit(list)
+         else
+           g_return_from_proc(list,parasize);
+    {$IFDEF NEWST}
+         list^.concat(new(pai_symbol_end,initname(aktprocdef^.mangledname)));
+    {$ELSE NEWST}
+         list^.concat(new(pai_symbol_end,initname(aktprocsym^.definition^.mangledname)));
+    {$ENDIF NEWST}
+
+    {$ifdef GDB}
+         if (cs_debuginfo in aktmoduleswitches) and not inlined  then
+             begin
+                aktprocsym^.concatstabto(list);
+                if assigned(procinfo^._class) then
+                  if (not assigned(procinfo^.parent) or
+                     not assigned(procinfo^.parent^._class)) then
+                    list^.concat(new(pai_stabs,init(strpnew(
+                     '"$t:v'+procinfo^._class^.numberstring+'",'+
+                     tostr(N_PSYM)+',0,0,'+tostr(procinfo^.selfpointer_offset)))));
+                  {!!!!!!!!!!!!
+                  else
+                    list^.concat(new(pai_stabs,init(strpnew(
+                     '"$t:r'+procinfo^._class^.numberstring+'",'+
+                     tostr(N_RSYM)+',0,0,'+tostr(GDB_i386index[R_ESI])))));
+                  }
+                if (tdef(aktprocsym^.definition^.rettype.def) <> tdef(voiddef)) then
+                  begin
+                    if ret_in_param(aktprocsym^.definition^.rettype.def) then
+                      list^.concat(new(pai_stabs,init(strpnew(
+                       '"'+aktprocsym^.name+':X*'+aktprocsym^.definition^.rettype.def^.numberstring+'",'+
+                       tostr(N_PSYM)+',0,0,'+tostr(procinfo^.return_offset)))))
+                    else
+                      list^.concat(new(pai_stabs,init(strpnew(
+                       '"'+aktprocsym^.name+':X'+aktprocsym^.definition^.rettype.def^.numberstring+'",'+
+                       tostr(N_PSYM)+',0,0,'+tostr(procinfo^.return_offset)))));
+                    if (m_result in aktmodeswitches) then
+                      if ret_in_param(aktprocsym^.definition^.rettype.def) then
+                        list^.concat(new(pai_stabs,init(strpnew(
+                         '"RESULT:X*'+aktprocsym^.definition^.rettype.def^.numberstring+'",'+
+                         tostr(N_PSYM)+',0,0,'+tostr(procinfo^.return_offset)))))
+                      else
+                        list^.concat(new(pai_stabs,init(strpnew(
+                         '"RESULT:X'+aktprocsym^.definition^.rettype.def^.numberstring+'",'+
+                         tostr(N_PSYM)+',0,0,'+tostr(procinfo^.return_offset)))));
+                  end;
+                mangled_length:=length(aktprocsym^.definition^.mangledname);
+                getmem(p,mangled_length+50);
+                strpcopy(p,'192,0,0,');
+                strpcopy(strend(p),aktprocsym^.definition^.mangledname);
+                list^.concat(new(pai_stabn,init(strnew(p))));
+                {list^.concat(new(pai_stabn,init(strpnew('192,0,0,'
+                 +aktprocsym^.definition^.mangledname))));
+                p[0]:='2';p[1]:='2';p[2]:='4';
+                strpcopy(strend(p),'_end');}
+                freemem(p,mangled_length+50);
+                list^.concat(new(pai_stabn,init(
+                  strpnew('224,0,0,'+aktexit2label^.name))));
+                 { strpnew('224,0,0,'
+                 +aktprocsym^.definition^.mangledname+'_end'))));}
+             end;
+    {$endif GDB}
+      end;
+
+{*****************************************************************************
+                       some abstract definitions
+ ****************************************************************************}
+
+    procedure tcg.a_call_name(list : taasmoutput;const s : string;
+      offset : longint);
+
+      begin
+         abstract;
+      end;
+
+    procedure tcg.g_stackframe_entry(list : taasmoutput;localsize : longint);
+
+      begin
+         abstract;
+      end;
+
+    procedure tcg.g_maybe_loadself(list : taasmoutput);
+
+      begin
+         abstract;
+      end;
+
+    procedure tcg.g_restore_frame_pointer(list : taasmoutput);
+
+      begin
+         abstract;
+      end;
+
+    procedure g_return_from_proc(list : taasmoutput;parasize : aword);
+
+      begin
+         abstract;
+      end;
+
+    procedure tcg.a_loadaddress_ref_reg(list : taasmoutput;const ref : treference;r : tregister);
+
+      begin
+         abstract;
+      end;
+
+    procedure tcg.g_push_exception_value_reg(list : taasmoutput;reg : tregister);
+
+      begin
+         abstract;
+      end;
+
+    procedure tcg.g_push_exception_value_const(list : taasmoutput;reg : tregister);
+
+      begin
+         abstract;
+      end;
+
+    procedure tcg.g_pop_exception_value_reg(list : taasmoutput;reg : tregister);
+
+      begin
+         abstract;
+      end;
+
+    procedure tcg.a_load_const_reg(list : taasmoutput;size : tcgsize;a : aword;register : tregister);
+
+      begin
+         abstract;
+      end;
+
+    procedure tcg.a_load_reg_ref(list : taasmoutput;size : tcgsize;register : tregister;const ref : treference);
+
+      begin
+         abstract;
+      end;
+
+    procedure tcg.a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref : treference;register : tregister);
+
+      begin
+         abstract;
+      end;
+
+    procedure tcg.a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister);
+
+      begin
+         abstract;
+      end;
+
+    procedure tcg.a_cmp_reg_const_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
+      l : tasmlabel);
+
+      begin
+         abstract;
+      end;
+
+    procedure tcg.a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel);
+
+      begin
+         abstract;
+      end;
+
+    procedure tcg.a_cmp_reg_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg : tregister;l : tasmlabel);
+
+      begin
+         abstract;
+      end;
+
+    procedure tcg.a_cmp_ref_const_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
+     l : tasmlabel);
+
+      begin
+         abstract;
+      end;
+
+    procedure tcg.a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
+
+      begin
+        abstract;
+      end;
+
+    procedure tcg.g_return_from_proc(list : taasmoutput;parasize : aword);
+
+      begin
+         abstract;
+      end;
+
+    procedure tcg.a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;nr : longint);
+
+      begin
+         abstract;
+      end;
+
+    procedure tcg.a_paramaddr_ref(list : taasmoutput;const r : treference;nr : longint);
+
+      begin
+         abstract;
+      end;
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-08-26 13:36:37  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.1  2000/07/13 06:30:07  michael
+    + Initial import
+
+  Revision 1.38  2000/04/29 09:01:06  jonas
+    * nmem compiles again (at least for powerpc)
+
+  Revision 1.37  2000/04/22 14:25:03  jonas
+    * aasm.pas: pai_align instead of pai_align_abstract if cpu <> i386
+    + systems.pas: info for macos/ppc
+    * new/cgobj.pas: compiles again without newst define
+    * new/powerpc/cgcpu: generate different entry/exit code depending on
+      whether target_os is MacOs or Linux
+
+  Revision 1.36  2000/03/11 21:11:24  daniel
+    * Ported hcgdata to new symtable.
+    * Alignment code changed as suggested by Peter
+    + Usage of my is operator replacement, is_object
+
+  Revision 1.35  2000/03/01 15:36:13  florian
+    * some new stuff for the new cg
+
+  Revision 1.34  2000/02/20 20:49:46  florian
+    * newcg is compiling
+    * fixed the dup id problem reported by Paul Y.
+
+  Revision 1.33  2000/01/07 01:14:53  peter
+    * updated copyright to 2000
+
+  Revision 1.32  1999/12/01 12:42:33  peter
+    * fixed bug 698
+    * removed some notes about unused vars
+
+  Revision 1.31  1999/11/05 13:15:00  florian
+    * some fixes to get the new cg compiling again
+
+  Revision 1.30  1999/11/05 07:05:56  jonas
+    + a_jmp_cond()
+
+  Revision 1.29  1999/10/21 16:41:41  florian
+    * problems with readln fixed: esi wasn't restored correctly when
+      reading ordinal fields of objects futher the register allocation
+      didn't take care of the extra register when reading ordinal values
+    * enumerations can now be used in constant indexes of properties
+
+  Revision 1.28  1999/10/12 21:20:46  florian
+    * new codegenerator compiles again
+
+  Revision 1.27  1999/09/29 11:46:20  florian
+    * fixed bug 292 from bugs directory
+
+  Revision 1.26  1999/09/14 11:16:09  florian
+    * only small updates to work with the current compiler
+
+  Revision 1.25  1999/09/03 13:09:09  jonas
+    * fixed typo regarding scratchregs pointer
+
+  Revision 1.24  1999/08/26 14:51:54  jonas
+    * changed get_scratch_reg so it actually uses the
+      scratch_reg_array_pointer
+
+  Revision 1.23  1999/08/25 12:00:11  jonas
+    * changed pai386, paippc and paiapha (same for tai*) to paicpu (taicpu)
+
+  Revision 1.22  1999/08/18 17:05:55  florian
+    + implemented initilizing of data for the new code generator
+      so it should compile now simple programs
+
+  Revision 1.21  1999/08/07 14:21:08  florian
+    * some small problems fixed
+
+  Revision 1.20  1999/08/06 18:05:52  florian
+    * implemented some stuff for assignments
+
+  Revision 1.19  1999/08/06 17:00:54  florian
+    + definition of concatcopy
+
+  Revision 1.18  1999/08/06 16:37:45  jonas
+    * completed bugfix done by Florian o I wouldn't get conflicts :)
+
+  Revision 1.17  1999/08/06 16:27:26  florian
+    * for Jonas: else he will get conflicts
+
+  Revision 1.16  1999/08/06 16:04:05  michael
+  + introduced tainstruction
+
+  Revision 1.15  1999/08/06 15:53:50  florian
+    * made the alpha version compilable
+
+  Revision 1.14  1999/08/06 14:15:51  florian
+    * made the alpha version compilable
+
+  Revision 1.13  1999/08/06 13:26:50  florian
+    * more changes ...
+
+  Revision 1.12  1999/08/05 17:10:56  florian
+    * some more additions, especially procedure
+      exit code generation
+
+  Revision 1.11  1999/08/05 14:58:11  florian
+    * some fixes for the floating point registers
+    * more things for the new code generator
+
+  Revision 1.10  1999/08/04 00:23:52  florian
+    * renamed i386asm and i386base to cpuasm and cpubase
+
+  Revision 1.9  1999/08/02 23:13:21  florian
+    * more changes to compile for the Alpha
+
+  Revision 1.8  1999/08/02 17:14:07  florian
+    + changed the temp. generator to an object
+
+  Revision 1.7  1999/08/01 23:05:55  florian
+    * changes to compile with FPC
+
+  Revision 1.6  1999/08/01 18:22:33  florian
+   * made it again compilable
+
+  Revision 1.5  1999/01/23 23:29:46  florian
+    * first running version of the new code generator
+    * when compiling exceptions under Linux fixed
+
+  Revision 1.4  1999/01/13 22:52:36  florian
+    + YES, finally the new code generator is compilable, but it doesn't run yet :(
+
+  Revision 1.3  1998/12/26 15:20:30  florian
+    + more changes for the new version
+
+  Revision 1.2  1998/12/15 22:18:55  florian
+    * some code added
+
+  Revision 1.1  1998/12/15 16:32:58  florian
+    + first version, derived from old routines
+
+}

compiler/htypechk.pas

@@ -131,11 +131,7 @@ implementation
        types,cpubase,
        ncnv,nld,
        nmem,ncal,nmat,
-{$ifdef newcg}
        cgbase
-{$else}
-       hcodegen
-{$endif}
        ;
 
     type
@@ -942,7 +938,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.31  2001-08-23 14:28:35  jonas
+  Revision 1.32  2001-08-26 13:36:37  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.31  2001/08/23 14:28:35  jonas
     + tempcreate/ref/delete nodes (allows the use of temps in the
       resulttype and first pass)
     * made handling of read(ln)/write(ln) processor independent

compiler/i386/cgai386.pas → compiler/i386/cga.pas

@@ -21,7 +21,7 @@
  ****************************************************************************
 }
 
-unit cgai386;
+unit cga;
 
 {$i defines.inc}
 
@@ -162,7 +162,7 @@ implementation
        globtype,systems,globals,verbose,
        fmodule,
        symbase,symsym,symtable,types,
-       tgcpu,temp_gen,hcodegen,regvars
+       tgcpu,temp_gen,cgbase,regvars
 {$ifdef GDB}
        ,gdb
 {$endif}
@@ -2980,7 +2980,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.29  2001-08-12 20:23:02  peter
+  Revision 1.2  2001-08-26 13:36:52  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.29  2001/08/12 20:23:02  peter
     * netbsd doesn't use stackchecking
 
   Revision 1.28  2001/08/07 18:47:13  peter

compiler/i386/csopt386.pas

@@ -41,7 +41,7 @@ Implementation
 
 Uses
   {$ifdef replaceregdebug}cutils,{$endif}
-  globtype, verbose, hcodegen, globals, daopt386, tgcpu, rropt386;
+  globtype, verbose, cgbase, globals, daopt386, tgcpu, rropt386;
 
 {
 Function TaiInSequence(P: Tai; Const Seq: TContent): Boolean;
@@ -1718,7 +1718,11 @@ End.
 
 {
   $Log$
-  Revision 1.15  2001-04-06 16:24:38  jonas
+  Revision 1.16  2001-08-26 13:36:55  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.15  2001/04/06 16:24:38  jonas
     * fixed bug due to short boolean evaluation
 
   Revision 1.14  2001/04/02 21:20:36  peter

compiler/i386/daopt386.pas

@@ -220,7 +220,7 @@ Var
 Implementation
 
 Uses
-  globals, systems, verbose, hcodegen, symconst, symsym, tgcpu;
+  globals, systems, verbose, cgbase, symconst, symsym, tgcpu;
 
 Type
   TRefCompare = function(const r1, r2: TReference): Boolean;
@@ -2452,7 +2452,11 @@ End.
 
 {
   $Log$
-  Revision 1.18  2001-08-06 21:40:50  peter
+  Revision 1.19  2001-08-26 13:36:55  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.18  2001/08/06 21:40:50  peter
     * funcret moved from tprocinfo to tprocdef
 
   Revision 1.17  2001/04/13 01:22:18  peter

compiler/i386/n386add.pas

@@ -44,10 +44,10 @@ interface
       globtype,systems,
       cutils,verbose,globals,widestr,
       symconst,symdef,aasm,types,
-      hcodegen,temp_gen,pass_2,
+      cgbase,temp_gen,pass_2,
       cpuasm,
       node,ncon,nset,
-      cgai386,n386util,tgcpu;
+      cga,n386util,tgcpu;
 
     function ti386addnode.getresflags(unsigned : boolean) : tresflags;
 
@@ -2293,7 +2293,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.16  2001-07-08 21:00:16  peter
+  Revision 1.17  2001-08-26 13:36:55  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.16  2001/07/08 21:00:16  peter
     * various widestring updates, it works now mostly without charset
       mapping supported
 

compiler/i386/n386cal.pas

@@ -60,10 +60,10 @@ implementation
 {$ifdef GDB}
       gdb,
 {$endif GDB}
-      hcodegen,temp_gen,pass_2,
+      cgbase,temp_gen,pass_2,
       cpubase,cpuasm,
       nmem,nld,
-      cgai386,tgcpu,n386ld,n386util,regvars;
+      cga,tgcpu,n386ld,n386util,regvars;
 
 {*****************************************************************************
                              TI386CALLPARANODE
@@ -1584,7 +1584,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.29  2001-08-19 21:11:21  florian
+  Revision 1.30  2001-08-26 13:36:56  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.29  2001/08/19 21:11:21  florian
     * some bugs fix:
       - overload; with external procedures fixed
       - better selection of routine to do an overloaded

compiler/i386/n386cnv.pas

@@ -68,10 +68,10 @@ implementation
    uses
       verbose,globals,systems,
       symconst,symdef,aasm,
-      hcodegen,temp_gen,pass_2,
+      cgbase,temp_gen,pass_2,
       ncon,ncal,
       cpubase,cpuasm,
-      cgai386,tgcpu,n386util;
+      cga,tgcpu,n386util;
 
 
 {*****************************************************************************
@@ -1425,7 +1425,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.19  2001-08-01 21:44:59  peter
+  Revision 1.20  2001-08-26 13:36:57  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.19  2001/08/01 21:44:59  peter
     * fixed empty pwidechar register allocation
 
   Revision 1.18  2001/07/30 20:59:29  peter

compiler/i386/n386con.pas

@@ -27,10 +27,11 @@ unit n386con;
 interface
 
     uses
-       ncon;
+       node,ncon;
 
     type
        ti386realconstnode = class(trealconstnode)
+          function pass_1 : tnode;override;
           procedure pass_2;override;
        end;
 
@@ -63,12 +64,24 @@ implementation
       symconst,symdef,aasm,types,
       temp_gen,
       cpubase,
-      cgai386,tgcpu;
+      cga,tgcpu;
 
 {*****************************************************************************
                            TI386REALCONSTNODE
 *****************************************************************************}
 
+    function ti386realconstnode.pass_1 : tnode;
+      begin
+         result:=nil;
+         if (value_real=1.0) or (value_real=0.0) then
+           begin
+              location.loc:=LOC_FPU;
+              registersfpu:=1;
+           end
+         else
+           location.loc:=LOC_MEM;
+      end;
+
     procedure ti386realconstnode.pass_2;
       const
         floattype2ait:array[tfloattype] of tait=
@@ -499,7 +512,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.9  2001-07-08 21:00:18  peter
+  Revision 1.10  2001-08-26 13:36:57  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.9  2001/07/08 21:00:18  peter
     * various widestring updates, it works now mostly without charset
       mapping supported
 

compiler/i386/n386flw.pas

@@ -87,10 +87,10 @@ implementation
     uses
       verbose,globtype,globals,systems,
       symconst,symdef,symsym,aasm,types,
-      hcodegen,temp_gen,pass_2,
+      cgbase,temp_gen,pass_2,
       cpubase,cpuasm,
       pass_1,nld,ncon,
-      cgai386,tgcpu,n386util,regvars;
+      cga,tgcpu,n386util,regvars;
 
 {*****************************************************************************
                          Second_While_RepeatN
@@ -1340,7 +1340,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.14  2001-08-06 21:40:50  peter
+  Revision 1.15  2001-08-26 13:36:58  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.14  2001/08/06 21:40:50  peter
     * funcret moved from tprocinfo to tprocdef
 
   Revision 1.13  2001/07/01 20:16:20  peter

compiler/i386/n386inl.pas

@@ -40,10 +40,10 @@ implementation
       globtype,systems,
       cutils,verbose,globals,fmodule,
       symconst,symbase,symtype,symdef,symsym,aasm,types,
-      hcodegen,temp_gen,pass_1,pass_2,
+      cgbase,temp_gen,pass_1,pass_2,
       cpubase,
       nbas,ncon,ncal,ncnv,nld,
-      cgai386,tgcpu,n386util;
+      cga,tgcpu,n386util;
 
 
 {*****************************************************************************
@@ -1719,7 +1719,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.20  2001-08-24 12:33:54  jonas
+  Revision 1.21  2001-08-26 13:36:58  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.20  2001/08/24 12:33:54  jonas
     * fixed big bug in handle_str that caused it to (almost) always call
       fpc_<stringtype>_longint
     * fixed small bug in handle_read_write that caused wrong warnigns about

compiler/i386/n386ld.pas

@@ -52,10 +52,10 @@ implementation
       systems,
       verbose,globals,
       symconst,symtype,symdef,symsym,symtable,aasm,types,
-      hcodegen,temp_gen,pass_2,
+      cgbase,temp_gen,pass_2,
       nmem,ncon,ncnv,
       cpubase,cpuasm,
-      cgai386,tgcpu,n386cnv,n386util,regvars;
+      cga,tgcpu,n386cnv,n386util,regvars;
 
 {*****************************************************************************
                              SecondLoad
@@ -1088,7 +1088,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.18  2001-08-06 21:40:50  peter
+  Revision 1.19  2001-08-26 13:36:59  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.18  2001/08/06 21:40:50  peter
     * funcret moved from tprocinfo to tprocdef
 
   Revision 1.17  2001/08/05 13:19:51  peter

compiler/i386/n386mat.pas

@@ -39,6 +39,7 @@ interface
       end;
 
       ti386unaryminusnode = class(tunaryminusnode)
+         function pass_1 : tnode;override;
          procedure pass_2;override;
       end;
 
@@ -52,10 +53,10 @@ implementation
       globtype,systems,
       cutils,verbose,globals,
       symconst,symdef,aasm,types,
-      hcodegen,temp_gen,pass_2,
+      cgbase,temp_gen,pass_1,pass_2,
       ncon,
       cpubase,
-      cgai386,tgcpu,n386util;
+      cga,tgcpu,n386util;
 
 {*****************************************************************************
                              TI386MODDIVNODE
@@ -652,9 +653,52 @@ implementation
 
 
 {*****************************************************************************
-                          Ti386UNARYMINUSNODE
+                          TI386UNARYMINUSNODE
 *****************************************************************************}
 
+    function ti386unaryminusnode.pass_1 : tnode;
+      begin
+         result:=nil;
+         firstpass(left);
+         if codegenerror then
+           exit;
+
+         registers32:=left.registers32;
+         registersfpu:=left.registersfpu;
+{$ifdef SUPPORT_MMX}
+         registersmmx:=left.registersmmx;
+{$endif SUPPORT_MMX}
+
+         if (left.resulttype.def.deftype=floatdef) then
+           begin
+             location.loc:=LOC_FPU;
+           end
+{$ifdef SUPPORT_MMX}
+         else if (cs_mmx in aktlocalswitches) and
+           is_mmx_able_array(left.resulttype.def) then
+             begin
+               if (left.location.loc<>LOC_MMXREGISTER) and
+                  (registersmmx<1) then
+                 registersmmx:=1;
+             end
+{$endif SUPPORT_MMX}
+         else if is_64bitint(left.resulttype.def) then
+           begin
+              if (left.location.loc<>LOC_REGISTER) and
+                 (registers32<2) then
+                registers32:=2;
+              location.loc:=LOC_REGISTER;
+           end
+         else if (left.resulttype.def.deftype=orddef) then
+           begin
+              if (left.location.loc<>LOC_REGISTER) and
+                 (registers32<1) then
+                registers32:=1;
+              location.loc:=LOC_REGISTER;
+           end;
+      end;
+
+
     procedure ti386unaryminusnode.pass_2;
 {$ifdef SUPPORT_MMX}
       procedure do_mmx_neg;
@@ -998,7 +1042,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.13  2001-04-13 01:22:19  peter
+  Revision 1.14  2001-08-26 13:37:00  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.13  2001/04/13 01:22:19  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/i386/n386mem.pas

@@ -92,10 +92,10 @@ implementation
       globtype,systems,
       cutils,verbose,globals,
       symconst,symbase,symtype,symdef,symsym,symtable,aasm,types,
-      hcodegen,temp_gen,pass_2,
+      cgbase,temp_gen,pass_2,
       pass_1,nld,ncon,nadd,
       cpubase,cpuasm,
-      cgai386,tgcpu,n386util;
+      cga,tgcpu,n386util;
 
 {*****************************************************************************
                             TI386LOADNODE
@@ -1055,7 +1055,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.14  2001-07-08 21:00:18  peter
+  Revision 1.15  2001-08-26 13:37:00  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.14  2001/07/08 21:00:18  peter
     * various widestring updates, it works now mostly without charset
       mapping supported
 

compiler/i386/n386obj.pas

@@ -37,14 +37,14 @@ uses
   nobj,
   temp_gen,
   cpubase,
-  cgai386, tgcpu;
+  cga, tgcpu;
 
    type
      ti386classheader=class(tclassheader)
      protected
        procedure cgintfwrapper(asmlist: TAAsmoutput; procdef: tprocdef; const labelname: string; ioffset: longint);override;
      end;
-     
+
 {
 possible calling conventions:
               default stdcall cdecl pascal popstack register saveregisters
@@ -211,7 +211,11 @@ initialization
 end.
 {
   $Log$
-  Revision 1.1  2001-04-21 13:37:17  peter
+  Revision 1.2  2001-08-26 13:37:00  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.1  2001/04/21 13:37:17  peter
     * made tclassheader using class of to implement cpu dependent code
 
   Revision 1.5  2001/04/13 01:22:19  peter

compiler/i386/n386opt.pas

@@ -41,7 +41,7 @@ type
 
 implementation
 
-uses pass_1, types, htypechk, hcodegen, temp_gen, cpubase, cgai386,
+uses pass_1, types, htypechk, cgbase, temp_gen, cpubase, cga,
      tgcpu, aasm, ncnv, ncon, pass_2, symdef;
 
 
@@ -248,7 +248,11 @@ end.
 
 {
   $Log$
-  Revision 1.4  2001-04-13 01:22:19  peter
+  Revision 1.5  2001-08-26 13:37:00  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.4  2001/04/13 01:22:19  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/i386/n386set.pas

@@ -47,10 +47,10 @@ implementation
       globtype,systems,cpuinfo,
       verbose,globals,
       symconst,symdef,aasm,types,
-      hcodegen,temp_gen,pass_2,
+      cgbase,temp_gen,pass_2,
       ncon,
       cpubase,
-      cgai386,tgcpu,n386util,regvars;
+      cga,tgcpu,n386util,regvars;
 
      const
        bytes2Sxx:array[1..8] of Topsize=(S_B,S_W,S_NO,S_L,S_NO,S_NO,S_NO,S_Q);
@@ -1072,7 +1072,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.15  2001-05-06 17:12:14  jonas
+  Revision 1.16  2001-08-26 13:37:00  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.15  2001/05/06 17:12:14  jonas
     * fixed an IE10 and another bug with [var1..var2] construct
 
   Revision 1.14  2001/04/13 01:22:19  peter

compiler/i386/n386util.pas

@@ -64,8 +64,8 @@ implementation
        types,
        ncon,nld,
        pass_1,pass_2,
-       hcodegen,tgcpu,temp_gen,
-       cgai386,regvars;
+       cgbase,tgcpu,temp_gen,
+       cga,regvars;
 
 
 {*****************************************************************************
@@ -1510,7 +1510,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.19  2001-08-24 12:22:14  jonas
+  Revision 1.20  2001-08-26 13:37:01  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.19  2001/08/24 12:22:14  jonas
     * fixed memory leak with coping of array-of-consts as valuepara
 
   Revision 1.18  2001/07/08 21:00:18  peter

compiler/i386/popt386.pas

@@ -37,7 +37,7 @@ Implementation
 
 Uses
   globtype,systems,
-  globals,hcodegen,
+  globals,cgbase,
 {$ifdef finaldestdebug}
   cobjects,
 {$endif finaldestdebug}
@@ -2021,7 +2021,11 @@ End.
 
 {
   $Log$
-  Revision 1.14  2001-08-01 09:46:55  jonas
+  Revision 1.15  2001-08-26 13:37:01  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.14  2001/08/01 09:46:55  jonas
     * fixed endless loop with web bug 1571 (merged)
 
   Revision 1.13  2001/04/13 01:22:19  peter

compiler/i386/ra386.pas

@@ -58,11 +58,7 @@ implementation
 uses
   globtype,globals,systems,verbose,
   symconst,symdef,symsym,
-{$ifdef NEWCG}
   cgbase,
-{$else}
-  hcodegen,
-{$endif}
   types,cpuasm;
 
 {$define ATTOP}
@@ -687,7 +683,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.11  2001-08-07 18:47:14  peter
+  Revision 1.12  2001-08-26 13:37:01  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.11  2001/08/07 18:47:14  peter
     * merged netbsd start
     * profile for win32
 

compiler/i386/ra386att.pas

@@ -50,11 +50,7 @@ Implementation
        scanner,
        ra386,rautils,
        { codegen }
-{$ifdef newcg}
        cgbase
-{$else}
-       hcodegen
-{$endif}
        ;
 
 type
@@ -2139,7 +2135,11 @@ finalization
 end.
 {
   $Log$
-  Revision 1.13  2001-08-06 21:40:50  peter
+  Revision 1.14  2001-08-26 13:37:02  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.13  2001/08/06 21:40:50  peter
     * funcret moved from tprocinfo to tprocdef
 
   Revision 1.12  2001/04/18 22:02:03  peter

compiler/i386/ra386dir.pas

@@ -49,11 +49,7 @@ interface
        scanner,
        ra386,
        { codegen }
-{$ifdef newcg}
        cgbase
-{$else}
-       hcodegen
-{$endif}
        ;
 
     function assemble : tnode;
@@ -299,7 +295,11 @@ initialization
 end.
 {
   $Log$
-  Revision 1.10  2001-08-06 21:40:51  peter
+  Revision 1.11  2001-08-26 13:37:02  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.10  2001/08/06 21:40:51  peter
     * funcret moved from tprocinfo to tprocdef
 
   Revision 1.9  2001/04/18 22:02:03  peter

compiler/i386/ra386int.pas

@@ -50,11 +50,7 @@ Implementation
        scanner,
        ra386,rautils,
        { codegen }
-{$ifdef newcg}
        cgbase
-{$else}
-       hcodegen
-{$endif}
        ;
 
 type
@@ -1968,7 +1964,11 @@ finalization
 end.
 {
   $Log$
-  Revision 1.16  2001-08-06 21:40:51  peter
+  Revision 1.17  2001-08-26 13:37:03  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.16  2001/08/06 21:40:51  peter
     * funcret moved from tprocinfo to tprocdef
 
   Revision 1.15  2001/04/18 22:02:03  peter

compiler/i386/tgcpu.pas

@@ -28,7 +28,7 @@ interface
 
     uses
        globals,
-       hcodegen,verbose,aasm,
+       cgbase,verbose,aasm,
        node,
        cpubase,cpuasm
        ;
@@ -674,7 +674,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.4  2001-04-13 01:22:21  peter
+  Revision 1.5  2001-08-26 13:37:03  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.4  2001/04/13 01:22:21  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/nadd.pas

@@ -50,11 +50,7 @@ implementation
       cutils,verbose,globals,widestr,
       symconst,symtype,symdef,symsym,types,
       cpuinfo,
-{$ifdef newcg}
       cgbase,
-{$else newcg}
-      hcodegen,
-{$endif newcg}
       htypechk,pass_1,
       nmat,ncnv,nld,ncon,nset,nopt,
       cpubase;
@@ -1287,7 +1283,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.32  2001-08-06 21:40:46  peter
+  Revision 1.33  2001-08-26 13:36:38  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.32  2001/08/06 21:40:46  peter
     * funcret moved from tprocinfo to tprocdef
 
   Revision 1.31  2001/07/08 21:00:14  peter

compiler/nbas.pas

@@ -141,10 +141,7 @@ implementation
       verbose,globals,globtype,systems,
       symconst,symdef,symsym,types,
       pass_1,
-      ncal,nflw,tgcpu,hcodegen
-{$ifdef newcg}
-      ,cgbase
-{$endif}
+      ncal,nflw,tgcpu,cgbase
       ;
 
 {*****************************************************************************
@@ -467,7 +464,7 @@ implementation
       begin
         n := ttempcreatenode(inherited getcopy);
         n.size := size;
-        
+
         new(n.tempinfo);
         fillchar(n.tempinfo^,sizeof(n.tempinfo^),0);
         n.tempinfo^.restype := tempinfo^.restype;
@@ -581,7 +578,7 @@ implementation
           { if the temp we refer to hasn't been copied, we have a }
           { problem since that means we now have two delete nodes }
           { for one temp                                          }
-          internalerror(200108234);        
+          internalerror(200108234);
         result := n;
       end;
 
@@ -602,7 +599,7 @@ implementation
           inherited docompare(p) and
           (ttemprefnode(p).tempinfo = tempinfo);
       end;
-      
+
     destructor ttempdeletenode.destroy;
       begin
         dispose(tempinfo);
@@ -620,7 +617,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.15  2001-08-24 13:47:26  jonas
+  Revision 1.16  2001-08-26 13:36:38  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.15  2001/08/24 13:47:26  jonas
     * moved "reverseparameters" from ninl.pas to ncal.pas
     + support for non-persistent temps in ttempcreatenode.create, for use
       with typeconversion nodes

compiler/ncal.pas

@@ -111,11 +111,8 @@ implementation
       verbose,globals,
       symconst,symtype,types,
       htypechk,pass_1,cpubase,
-      ncnv,nld,ninl,nadd,ncon,hcodegen,
-      tgcpu
-{$ifdef newcg}
-      ,cgbase
-{$endif newcg}
+      ncnv,nld,ninl,nadd,ncon,
+      tgcpu,cgbase
       ;
 
 
@@ -1487,7 +1484,10 @@ implementation
                 end;
 
 {$ifndef newcg}
+{$ifndef POWERPC}
+             { for the PowerPC standard calling conventions this information isn't necassary (FK) }
              incrementregisterpushed(tprocdef(procdefinition).usedregisters);
+{$endif POWERPC}
 {$endif newcg}
            end;
 
@@ -1717,7 +1717,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.44  2001-08-24 13:47:27  jonas
+  Revision 1.45  2001-08-26 13:36:39  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.44  2001/08/24 13:47:27  jonas
     * moved "reverseparameters" from ninl.pas to ncal.pas
     + support for non-persistent temps in ttempcreatenode.create, for use
       with typeconversion nodes

compiler/ncgbas.pas

@@ -45,7 +45,7 @@ interface
        tcgblocknode = class(tblocknode)
           procedure pass_2;override;
        end;
-       
+
        tcgtempcreatenode = class(ttempcreatenode)
           procedure pass_2;override;
        end;
@@ -66,16 +66,10 @@ interface
       aasm,symconst,symsym,symtable,types,
       htypechk,
       cpubase,cpuasm,
-      nflw,pass_2
-{$ifdef newcg}
-      ,cgbase
-{$else newcg}
-      ,hcodegen
-{$endif}
-{$ifdef i386}
-      ,cgai386
-{$endif}
-      ,tgcpu,temp_gen
+      nflw,pass_2,
+      cgbase,
+      cga,
+      tgcpu,temp_gen
       ;
 {*****************************************************************************
                                  TNOTHING
@@ -285,7 +279,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.6  2001-08-24 13:47:27  jonas
+  Revision 1.7  2001-08-26 13:36:39  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.6  2001/08/24 13:47:27  jonas
     * moved "reverseparameters" from ninl.pas to ncal.pas
     + support for non-persistent temps in ttempcreatenode.create, for use
       with typeconversion nodes

compiler/ncnv.pas

@@ -105,11 +105,7 @@ implementation
       cutils,verbose,globals,widestr,
       symconst,symdef,symsym,symtable,
       ncon,ncal,nset,nadd,
-{$ifdef newcg}
       cgbase,
-{$else newcg}
-      hcodegen,
-{$endif newcg}
       htypechk,pass_1,cpubase,cpuinfo;
 
 
@@ -1437,7 +1433,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.31  2001-08-05 13:19:51  peter
+  Revision 1.32  2001-08-26 13:36:40  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.31  2001/08/05 13:19:51  peter
     * partly fix for proc of obj=nil
 
   Revision 1.30  2001/07/30 20:59:27  peter

compiler/ncon.pas

@@ -293,8 +293,10 @@ implementation
                              TREALCONSTNODE
 *****************************************************************************}
 
+    { generic code     }
+    { overridden by:   }
+    {   i386           }
     constructor trealconstnode.create(v : bestreal;const t:ttype);
-
       begin
          inherited create(realconstn);
          restype:=t;
@@ -323,13 +325,7 @@ implementation
     function trealconstnode.pass_1 : tnode;
       begin
          result:=nil;
-         if (value_real=1.0) or (value_real=0.0) then
-           begin
-              location.loc:=LOC_FPU;
-              registersfpu:=1;
-           end
-         else
-           location.loc:=LOC_MEM;
+         location.loc:=LOC_MEM;
       end;
 
     function trealconstnode.docompare(p: tnode): boolean;
@@ -660,7 +656,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.20  2001-08-06 10:18:39  jonas
+  Revision 1.21  2001-08-26 13:36:40  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.20  2001/08/06 10:18:39  jonas
     * restype wasn't copied for some constant nodetypes in getcopy
 
   Revision 1.19  2001/07/08 21:00:15  peter

compiler/new/cgobj.pas

@@ -27,10 +27,7 @@ unit cgobj;
 
     uses
        cobjects,aasm,symtable,cpuasm,cpubase,cgbase,cpuinfo,tainst
-       {$IFDEF NEWST}
-       {$ELSE}
-       ,symconst
-       {$ENDIF NEWST};
+       symconst;
 
     type
        talignment = (AM_NATURAL,AM_NONE,AM_2BYTE,AM_4BYTE,AM_8BYTE);
@@ -1329,8 +1326,12 @@ unit cgobj;
 end.
 {
   $Log$
-  Revision 1.1  2000-07-13 06:30:07  michael
-  + Initial import
+  Revision 1.2  2001-08-26 13:37:04  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.1  2000/07/13 06:30:07  michael
+    + Initial import
 
   Revision 1.38  2000/04/29 09:01:06  jonas
     * nmem compiles again (at least for powerpc)
@@ -1462,4 +1463,4 @@ end.
   Revision 1.1  1998/12/15 16:32:58  florian
     + first version, derived from old routines
 
-}
+}

compiler/new/convtree.pas

@@ -1,100 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 by Florian Klaempfl
-
-    Converts the old tree nodes into the new OOP nodest
-    This unit is necessary to interface the new code generator
-    with the old parser
-
-    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 convtree;
-
-  interface
-
-    uses
-       tree;
-
-    function convtree2node(p : ptree) : pnode;
-
-  implementation
-
-    uses
-       verbose,nstatmnt,nmem;
-
-    function convtree2node(p : ptree) : pnode;
-
-      function doconv(p : ptree) : pnode;
-
-        var
-           node : pnode;
-
-        begin
-           if assigned(p) then
-             begin
-                case p^.treetype of
-                  blockn:
-                    node:=new(pblocknode,init(doconv(p^.left)));
-                  assignn:
-                    node:=new(passignmentnode,init(doconv(p^.left),
-                      doconv(p^.right)));
-                  statementn:
-                    node:=new(pstatementnode,init(doconv(p^.left),
-                      doconv(p^.right)));
-                  loadn:
-                    node:=new(ploadnode,init(p^.symtableentry,p^.symtable));
-                  else internalerror(1209993);
-                end;
-                doconv:=node;
-             end
-           else
-             doconv:=nil;
-        end;
-
-      begin
-         convtree2node:=doconv(p);
-         disposetree(p);
-      end;
-
-end.
-{
-  $Log$
-  Revision 1.1  2000-07-13 06:30:08  michael
-  + Initial import
-
-  Revision 1.6  2000/01/07 01:14:53  peter
-    * updated copyright to 2000
-
-  Revision 1.5  1999/09/14 11:16:09  florian
-    * only small updates to work with the current compiler
-
-  Revision 1.4  1999/01/24 22:32:35  florian
-    * well, more changes, especially parts of secondload ported
-
-  Revision 1.3  1999/01/23 23:29:47  florian
-    * first running version of the new code generator
-    * when compiling exceptions under Linux fixed
-
-  Revision 1.2  1999/01/19 10:19:04  florian
-    * bug with mul. of dwords fixed, reported by Alexander Stohr
-    * some changes to compile with TP
-    + small enhancements for the new code generator
-
-  Revision 1.1  1999/01/13 22:52:37  florian
-    + YES, finally the new code generator is compilable, but it doesn't run yet :(
-
-}

compiler/new/powerpc/agas.pas

@@ -1,298 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 by Florian Klaempfl
-
-    This unit implements an asm 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 agas;
-
-  interface
-
-    uses
-       cpubase,dos,globals,systems,{errors,}cobjects,aasm,strings,files,
-       agatt
-{$ifdef GDB}
-       ,gdb
-{$endif GDB}
-       ;
-
-    type
-      paicpuattasmlist=^taicpuattasmlist;
-      taicpuattasmlist=object(tattasmlist)
-        function getreferencestring(var ref : treference) : string; Virtual;
-        function getopstr_jmp(const o:toper) : string; Virtual;
-
-        procedure WriteInstruction (HP : Pai); virtual;
-        function cond2str(op: tasmop; c: tasmcond): string;
-
-        { to construct the output for conditional branches }
-        function branchmode(o: tasmop): string[4];
-
-      end;
-
-  implementation
-
-    uses cpuasm;
-
-    const
-       att_op2str : array[tasmop] of string[14] = ('<none>',
-    'add','add.','addo','addo.','addc','addc.','addco','addco.',
-    'adde','adde.','addeo','addeo.','addi','addic','addic.','addis',
-    'addme','addme.','addmeo','addmeo.','addze','addze.','addzeo',
-    'addzeo.','and','and.','andc','andc.','andi.','andis.','b',
-    'ba','bl','bla','bc','bca','bcl','bcla','bcctr','bcctrl','bclr',
-    'bclrl','cmp','cmpi','cmpl','cmpli','cntlzw','cntlzw.','crand',
-    'crandc','creqv','crnand','crnor','cror','crorc','crxor','dcba',
-    'dcbf','dcbi','dcbst','dcbt','divw','divw.','divwo','divwo.',
-    'divwu','divwu.','divwuo','divwuo.','eciwx','ecowx','eieio','eqv',
-    'eqv.','extsb','extsb.','extsh','extsh.','fabs','fabs.','fadd',
-    'fadd.','fadds','fadds.','fcompo','fcmpu','fctiw','fctw.','fctwz',
-    'fctwz.','fdiv','fdiv.','fdivs','fdivs.','fmadd','fmadd.','fmadds',
-    'fmadds.','fmr','fmsub','fmsub.','fmsubs','fmsubs.','fmul','fmul.',
-    'fmuls','fmuls.','fnabs','fnabs.','fneg','fneg.','fnmadd',
-    'fnmadd.','fnmadds','fnmadds.','fnmsub','fnmsub.','fnmsubs',
-    'fnmsubs.','fres','fres.','frsp','frsp.','frsqrte','frsqrte.',
-    'fsel','fsel.','fsqrt','fsqrt.','fsqrts','fsqrts.','fsub','fsub.',
-    'fsubs','fsubs.','icbi','isync','lbz','lbzu','lbzux','lbzx',
-    'lfd','lfdu','lfdux','lfdx','lfs','lfsu','lfsux','lfsx','lha',
-    'lhau','lhaux','lhax','hbrx','lhz','lhzu','lhzux','lhzx','lmw',
-    'lswi','lswx','lwarx','lwbrx','lwz','lwzu','lwzux','lwzx','mcrf',
-    'mcrfs','lcrxe','mfcr','mffs','maffs.','mfmsr','mfspr','mfsr',
-    'mfsrin','mftb','mtfcrf','mtfd0','mtfsb1','mtfsf','mtfsf.',
-    'mtfsfi','mtfsfi.','mtmsr','mtspr','mtsr','mtsrin','mulhw',
-    'mulhw.','mulhwu','mulhwu.','mulli','mullh','mullw.','mullwo',
-    'mullwo.','nand','nand.','neg','neg.','nego','nego.','nor','nor.',
-    'or','or.','orc','orc.','ori','oris', 'rfi', 'rlwimi', 'rlwimi.',
-    'rlwinm', 'tlwinm.','rlwnm','sc','slw', 'slw.', 'sraw', 'sraw.',
-    'srawi', 'srawi.','srw', 'srw.', 'stb', 'stbu', 'stbux','stbx','stfd',
-    'stfdu', 'stfdux', 'stfdx', 'stfiwx', 'stfs', 'stfsu', 'stfsux', 'stfsx',
-    'sth', 'sthbrx', 'sthu', 'sthux', 'sthx', 'stmw', 'stswi', 'stswx', 'stw',
-    'stwbrx', 'stwx.', 'stwu', 'stwux', 'stwx', 'subf', 'subf.', 'subfo',
-    'subfo.', 'subfc', 'subc.', 'subfco', 'subfco.', 'subfe', 'subfe.',
-    'subfeo', 'subfeo.', 'subfic', 'subfme', 'subfme.', 'subfmeo', 'subfmeo.',
-    'subfze', 'subfze.', 'subfzeo', 'subfzeo.', 'sync', 'tlbia', 'tlbie',
-    'tlbsync', 'tw', 'twi', 'xor', 'xor.', 'xori', 'xoris',
-    { some simplified mnemonics }
-    'subi', 'subis', 'subic', 'subic.', 'sub', 'sub.', 'subo', 'subo.',
-    'subc', 'subc.', 'subco', '.subco.', 'cmpwi', 'cmpw', 'cmplwi', 'cmplw',
-    'extlwi', 'extlwi.', 'extrwi', 'extrwi.', 'inslwi', 'inslwi.', 'insrwi',
-    'insrwi.', 'rotlwi', 'rotlwi.', 'rotlw', 'rotlw.', 'slwi', 'slwi.',
-    'srwi', 'srwi.', 'clrlwi', 'clrlwi.', 'clrrwi', 'clrrwi.', 'clrslwi',
-    'clrslwi.', 'blr', 'bctr', 'blrl', 'bctrl', 'crset', 'crclr', 'crmove',
-    'crnot', 'mt', 'mf','nop', 'li', 'lis', 'la', 'mr','not', 'mtcr');
-
-    function taicpuattasmlist.getreferencestring(var ref : treference) : string;
-    var
-      s : string;
-    begin
-      if ref.is_immediate then
-       begin
-{$ifndef testing}
-         internalerror(1000101);
-         exit;
-{$else testing}
-         writeln('internalerror 1000101');
-         halt(1);
-{$endif testing}
-       end
-      else
-       begin
-         with ref do
-          begin
-            inc(offset,offsetfixup);
-            if (offset < -32768) or (offset > 32767) then
-{$ifndef testing}
-              internalerror(19991);
-{$else testing}
-              begin
-                writeln('internalerror 19991');
-                halt(1);
-              end;
-{$endif testing}
-            s:='';
-            if assigned(symbol) then
-             s:=s+symbol^.name + symaddr2str[symaddr];
-            if offset<0 then
-             s:=s+tostr(offset)
-            else
-             if (offset>0) then
-              begin
-                if assigned(symbol) then
-                 s:=s+'+'+tostr(offset)
-                else
-                 s:=s+tostr(offset);
-              end;
-             if (index=R_NO) and (base<>R_NO) then
-               s:=s+'('+att_reg2str[base]+')'
-             else if (index<>R_NO) and (base<>R_NO) and (offset = 0) then
-               s:=s+att_reg2str[base]+','+att_reg2str[index]
-             else if ((index<>R_NO) or (base<>R_NO)) then
-{$ifndef testing}
-              internalerror(19992);
-{$else testing}
-              begin
-                writeln('internalerror 19992');
-                halt(1);
-              end;
-{$endif testing}
-          end;
-       end;
-      getreferencestring:=s;
-    end;
-
-    function taicpuattasmlist.getopstr_jmp(const o:toper) : string;
-    var
-      hs : string;
-    begin
-      case o.typ of
-        top_reg :
-          getopstr_jmp:=att_reg2str[o.reg];
-        { no top_ref jumping for powerpc }
-        top_const :
-          getopstr_jmp:=tostr(o.val);
-        top_symbol :
-          begin
-            hs:=o.sym^.name;
-            if o.symofs>0 then
-             hs:=hs+'+'+tostr(o.symofs)
-            else
-             if o.symofs<0 then
-              hs:=hs+tostr(o.symofs);
-            getopstr_jmp:=hs;
-          end;
-        else
-{$ifndef testing}
-          internalerror(10001);
-{$else testing}
-          begin
-            writeln('internalerror 10001');
-            halt(1);
-          end;
-{$endif testing}
-      end;
-    end;
-
-
-    Procedure taicpuattasmlist.WriteInstruction (HP : Pai);
-    var op: TAsmOp;
-        s: string;
-        i: byte;
-        sep: string[3];
-    begin
-      op:=paicpu(hp)^.opcode;
-      if is_calljmp(op) then
-    { direct BO/BI in op[0] and op[1] not supported, put them in condition! }
-        s:=s+cond2str(op,paicpu(hp)^.condition)+
-           getopstr_jmp(paicpu(hp)^.oper[0])
-      else
-    { process operands }
-        begin
-          s:=#9+att_op2str[op];
-          if paicpu(hp)^.ops<>0 then
-            begin
-              if not is_calljmp(op) then
-                sep := ','
-              else sep := '#9';
-              for i:=0 to paicpu(hp)^.ops-1 do
-              begin
-                s:=s+sep+getopstr(paicpu(hp)^.oper[i])
-                sep:=',';
-              end;
-            end;
-        end;
-      AsmWriteLn(s);
-    end;
-
-    function taicpuattasmlist.cond2str(op: tasmop; c: tasmcond): string;
-    { note: no checking is performed whether the given combination of }
-    { conditions is valid                                             }
-    var tempstr: sintrg;
-    begin
-      tempstr := '#9';
-      case c.simple of
-        false: cond2str := tempstr+att_op2str[op]+'#9'+tostr(c.bo)+','+
-                           tostr(c.bi);
-        true:
-          if (op >= A_B) and (op <= A_BCLRL) then
-            case c.cond of
-              { unconditional branch }
-              CF_NONE: condstr := tempstr+op2str(op);
-              { bdnzt etc }
-              else
-                begin
-                  tempstr := tempstr+'b'+asmcondflag2str[c.cond]+
-                              branchmode(op)+'#9';
-                  case op of
-                    CF_LT..CF_NU:
-                      cond2str := tempstr+att_reg2str[c.cr];
-                    CF_T..CF_DZF:
-                      cond2str := tempstr+tostr(c.crbit);
-                  end;
-                end;
-            end
-          { we have a trap instruction }
-          { not yet implementer !!!!!!!!!!!!!!!!!!!!! }
-{          else
-            begin
-              case tempstr := 'tw';}
-      end;
-    end;
-
-    function taicpuattasmlist.branchmode(o: tasmop): string[4];
-      var tempstr: string[4];
-      begin
-        tempstr := '';
-        case o of
-          A_BCCTR,A_BCCTRL: tempstr := 'ctr'
-          A_BCLR,A_BCLRL: tempstr := 'lr'
-        case o of
-          A_BL,A_BLA,A_BCL,A_BCLA,A_BCCTRL,A_BCLRL: tempstr := tempstr+'l';
-        end;
-        case o of
-          A_BA,A_BLA,A_BCA,A_BCLA: tempstr:=tempstr+'a';
-        end;
-        branchmode := tempstr;
-      end;
-
-end.
-{
-  $Log$
-  Revision 1.1  2000-07-13 06:30:12  michael
-  + Initial import
-
-  Revision 1.6  2000/05/01 11:03:32  jonas
-    * some fixes, does not yet compile
-
-  Revision 1.5  2000/03/26 16:37:36  jonas
-    + use cpubase unit
-    - removed use of alpha unit
-
-  Revision 1.4  2000/01/07 01:14:57  peter
-    * updated copyright to 2000
-
-  Revision 1.3  1999/09/03 13:15:47  jonas
-    + implemented most necessary methods
-
-  Revision 1.2  1999/08/25 12:00:22  jonas
-    * changed pai386, paippc and paiapha (same for tai*) to paicpu (taicpu)
-
-  Revision 1.1  1999/08/03 23:37:52  jonas
-    + initial implementation for PowerPC based on the Alpha stuff
-
-}

compiler/new/powerpc/aoptcpu.pas

@@ -1,55 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 by Jonas Maebe, member of the Free Pascal
-    Development Team
-
-    This unit implements the PowerPC optimizer object
-
-    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 aoptcpu;
-
-Interface
-
-uses cpubase, aoptobj, aoptcpub;
-
-Type
-  TAOptCpu = Object(TAoptObj)
-    { uses the same constructor as TAopObj }
-  End;
-
-Implementation
-
-End.
-{
- $Log$
- Revision 1.2  2001-08-26 13:29:33  florian
-   * some cg reorganisation
-   * some PPC updates
-
- Revision 1.1  2000/07/13 06:30:12  michael
-   + Initial import
-
- Revision 1.2  2000/01/07 01:14:57  peter
-   * updated copyright to 2000
-
- Revision 1.1  1999/12/24 22:49:23  jonas
-   + dummy to allow compiling
-
-}

compiler/new/powerpc/aoptcpub.pas

@@ -1,132 +0,0 @@
- {
-    $Id$
-    Copyright (c) 1998-2000 by Jonas Maebe, member of the Free Pascal
-    Development Team
-
-    This unit contains several types and constants necessary for the
-    optimizer to work on the 80x86 architecture
-
-    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 aoptcpub; { Assembler OPTimizer CPU specific Base }
-
-{ enable the following define if memory references can have both a base and }
-{ index register in 1 operand                                               }
-
-{$define RefsHaveIndexReg}
-
-{ enable the following define if memory references can have a scaled index }
-
-{ define RefsHaveScale}
-
-{ enable the following define if memory references can have a segment }
-{ override                                                            }
-
-{ define RefsHaveSegment}
-
-Interface
-
-Uses
-  CPUAsm,AOptBase;
-
-Type
-
-{ type of a normal instruction }
-  TInstr = Taicpu;
-  PInstr = ^TInstr;
-
-{ ************************************************************************* }
-{ **************************** TCondRegs ********************************** }
-{ ************************************************************************* }
-{ Info about the conditional registers                                      }
-  TCondRegs = Object
-    Constructor Init;
-    Destructor Done;
-  End;
-
-{ ************************************************************************* }
-{ **************************** TAoptBaseCpu ******************************* }
-{ ************************************************************************* }
-
-  TAoptBaseCpu = Object(TAoptBase)
-  End;
-
-
-{ ************************************************************************* }
-{ ******************************* Constants ******************************* }
-{ ************************************************************************* }
-Const
-
-{ the maximum number of things (registers, memory, ...) a single instruction }
-{ changes                                                                    }
-
-  MaxCh = 3;
-
-{ the maximum number of operands an instruction has }
-
-  MaxOps = 3;
-
-{Oper index of operand that contains the source (reference) with a load }
-{instruction                                                            }
-
-  LoadSrc = 0;
-
-{Oper index of operand that contains the destination (register) with a load }
-{instruction                                                                }
-
-  LoadDst = 1;
-
-{Oper index of operand that contains the source (register) with a store }
-{instruction                                                            }
-
-  StoreSrc = 0;
-
-{Oper index of operand that contains the destination (reference) with a load }
-{instruction                                                                 }
-
-  StoreDst = 1;
-
-Implementation
-
-{ ************************************************************************* }
-{ **************************** TCondRegs ********************************** }
-{ ************************************************************************* }
-Constructor TCondRegs.init;
-Begin
-End;
-
-Destructor TCondRegs.Done; {$ifdef inl} inline; {$endif inl}
-Begin
-End;
-
-End.
-
-{
- $Log$
- Revision 1.1  2000-07-13 06:30:12  michael
- + Initial import
-
- Revision 1.3  2000/03/26 16:38:27  jonas
-   + basic properties
-
- Revision 1.2  2000/01/07 01:14:57  peter
-   * updated copyright to 2000
-
- Revision 1.1  1999/11/09 22:57:09  peter
-   * compiles again both i386,alpha both with optimizer
-
-}

compiler/new/powerpc/aoptcpuc.pas

@@ -1,51 +0,0 @@
- {
-    $Id$
-    Copyright (c) 1998-2000 by Jonas Maebe, member of the Free Pascal
-    Development Team
-
-    This unit contains the processor specific implementation of the
-    assembler optimizer common subexpression elimination object.
-
-    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 aoptcpuc;
-
-Interface
-
-Uses
-  AOptCs;
-
-Type
-  TRegInfoCpu = Object(TRegInfo)
-  End;
-
-
-Implementation
-
-End.
-{
-  $Log$
-  Revision 1.1  2000-07-13 06:30:12  michael
-  + Initial import
-
-  Revision 1.2  2000/01/07 01:14:57  peter
-    * updated copyright to 2000
-
-  Revision 1.1  1999/11/09 22:57:09  peter
-    * compiles again both i386,alpha both with optimizer
-
-}

compiler/new/powerpc/aoptcpud.pas

@@ -1,53 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 by Jonas Maebe, member of the Free Pascal
-    Development Team
-
-    This unit contains the processor specific implementation of the
-    assembler optimizer data flow analyzer.
-
-    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 aoptcpud;
-
-Interface
-
-uses
-  AOptDA;
-
-Type
-  PAOptDFACpu = ^TAOptDFACpu;
-  TAOptDFACpu = Object(TAOptDFA)
-  End;
-
-Implementation
-
-
-End.
-
-{
-  $Log$
-  Revision 1.1  2000-07-13 06:30:12  michael
-  + Initial import
-
-  Revision 1.2  2000/01/07 01:14:57  peter
-    * updated copyright to 2000
-
-  Revision 1.1  1999/11/09 22:57:09  peter
-    * compiles again both i386,alpha both with optimizer
-
-}

compiler/new/powerpc/cga.pas

@@ -1,43 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 by Florian Klaempfl
-
-    Helper routines for the i386 code generator
-
-    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 cga;
-
-{$i defines.inc}
-
-interface
-
-    uses
-       cpubase,cpuasm,
-       symconst,symtype,symdef,aasm;
-
-implementation
-
-end.
-{
-  $Log$
-  Revision 1.1  2001-08-26 13:29:33  florian
-    * some cg reorganisation
-    * some PPC updates
-
-}

compiler/new/powerpc/cgcpu.pas

@@ -1,807 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 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;
-
-  interface
-
-    uses
-       cgbase,cgobj,aasm,cpuasm,cpubase,cpuinfo;
-
-    type
-       pcgppc = ^tcgppc;
-
-       tcgppc = object(tcg)
-          { 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_reg(list : paasmoutput;size : tcgsize;r : tregister;nr : longint);virtual;
-          procedure a_param_const(list : paasmoutput;size : tcgsize;a : aword;nr : longint);virtual;
-          procedure a_param_ref(list : paasmoutput;size : tcgsize;const r : treference;nr : longint);virtual;
-          procedure a_paramaddr_ref(list : paasmoutput;const r : treference;nr : longint);virtual;
-
-
-          procedure a_call_name(list : paasmoutput;const s : string;
-            offset : longint);virtual;
-
-          procedure a_op_reg_const(list : paasmoutput; Op: TOpCG; size: TCGSize; reg: TRegister; a: AWord); virtual;
-
-          { move instructions }
-          procedure a_load_const_reg(list : paasmoutput; size: tcgsize; a : aword;reg : tregister);virtual;
-          procedure a_load_reg_ref(list : paasmoutput; size: tcgsize; reg : tregister;const ref2 : treference);virtual;
-          procedure a_load_ref_reg(list : paasmoutput;size : tcgsize;const Ref2 : treference;reg : tregister);virtual;
-          procedure a_load_reg_reg(list : paasmoutput;size : tcgsize;reg1,reg2 : tregister);virtual;
-
-          {  comparison operations }
-          procedure a_cmp_reg_const_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
-            l : pasmlabel);virtual;
-          procedure a_cmp_reg_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : pasmlabel);
-          procedure a_jmp_cond(list : paasmoutput;cond : TOpCmp;l: pasmlabel);
-
-
-          procedure g_stackframe_entry_sysv(list : paasmoutput;localsize : longint);
-          procedure g_stackframe_entry_mac(list : paasmoutput;localsize : longint);
-          procedure g_stackframe_entry(list : paasmoutput;localsize : longint);virtual;
-          procedure g_restore_frame_pointer(list : paasmoutput);virtual;
-          procedure g_return_from_proc(list : paasmoutput;parasize : aword); virtual;
-          procedure g_return_from_proc_sysv(list : paasmoutput;parasize : aword);
-          procedure g_return_from_proc_mac(list : paasmoutput;parasize : aword);
-
-          procedure a_loadaddress_ref_reg(list : paasmoutput;const ref2 : treference;r : tregister);virtual;
-
-          procedure g_concatcopy(list : paasmoutput;const source,dest : treference;len : aword;loadref : boolean);virtual;
-
-
-          private
-
-          { Generates                                                                }
-          {   OpLo reg1, reg2, (a and $ffff) and/or }
-          {   OpHi reg1, reg2, (a shr 16)           }
-          { depending on the value of a             }
-          procedure a_op_reg_reg_const32(list: paasmOutPut; oplo, ophi: tasmop;
-                                          reg1, reg2: tregister; a: aword);
-          { Make sure ref is a valid reference for the PowerPC and sets the }
-          { base to the value of the index if (base = R_NO).                }
-          procedure fixref(var ref: treference);
-
-          { contains the common code of a_load_reg_ref and a_load_ref_reg }
-          procedure a_load_store(list:paasmoutput;op: tasmop;reg:tregister;
-                      var ref: treference);
-
-          { creates the correct branch instruction for a given combination }
-          { of asmcondflags and destination addressing mode                }
-          procedure a_jmp(list: paasmoutput; op: tasmop;
-                          c: tasmcondflags; l: pasmlabel);
-
-       end;
-
-const
-  TOpCG2AsmOpLo: Array[topcg] of TAsmOp = (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);
-  TOpCG2AsmOpHi: Array[topcg] of TAsmOp = (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);
-
-  TOpCmp2AsmCond: Array[topcmp] of TAsmCondFlags = (CF_NONE,CF_EQ,CF_GT,
-                       CF_LT,CF_GE,CF_LE,CF_NE,CF_LE,CF_NG,CF_GE,CF_NL);
-
-  LoadInstr: Array[OS_8..OS_32,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)));
-
-  StoreInstr: Array[OS_8..OS_32,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)));
-
-
-  implementation
-
-    uses
-       globtype,globals,verbose,systems;
-
-{ parameter passing... Still needs extra support from the processor }
-{ independent code generator                                        }
-
-    procedure tcgppc.a_param_reg(list : paasmoutput;size : tcgsize;r : tregister;nr : longint);
-
-    var ref: treference;
-
-    begin
-{$ifdef para_sizes_known}
-      if (nr <= max_param_regs_int) then
-        a_load_reg_reg(list,size,r,param_regs_int[nr])
-      else
-        begin
-          reset_reference(ref);
-          ref.base := stack_pointer;
-          ref.offset := LinkageAreaSize+para_size_till_now;
-          a_load_reg_ref(list,size,reg,ref);
-        end;
-{$endif para_sizes_known}
-    end;
-
-
-    procedure tcgppc.a_param_const(list : paasmoutput;size : tcgsize;a : aword;nr : longint);
-
-    var ref: treference;
-
-    begin
-{$ifdef para_sizes_known}
-      if (nr <= max_param_regs_int) then
-        a_load_const_reg(list,size,a,param_regs_int[nr])
-      else
-        begin
-          reset_reference(ref);
-          ref.base := stack_pointer;
-          ref.offset := LinkageAreaSize+para_size_till_now;
-          a_load_const_ref(list,size,a,ref);
-        end;
-{$endif para_sizes_known}
-    end;
-
-
-    procedure tcgppc.a_param_ref(list : paasmoutput;size : tcgsize;const r : treference;nr : longint);
-
-    var ref: treference;
-        tmpreg: tregister;
-
-    begin
-{$ifdef para_sizes_known}
-      if (nr <= max_param_regs_int) then
-        a_load_ref_reg(list,size,r,param_regs_int[nr])
-      else
-        begin
-          reset_reference(ref);
-          ref.base := stack_pointer;
-          ref.offset := LinkageAreaSize+para_size_till_now;
-          tmpreg := get_scratch_reg(list);
-          a_load_ref_reg(list,size,r,tmpreg);
-          a_load_reg_ref(list,size,tmpreg,ref);
-          free_scratch_reg(list,tmpreg);
-        end;
-{$endif para_sizes_known}
-    end;
-
-
-    procedure tcgppc.a_paramaddr_ref(list : paasmoutput;const r : treference;nr : longint);
-
-    var ref: treference;
-        tmpreg: tregister;
-
-    begin
-{$ifdef para_sizes_known}
-      if (nr <= max_param_regs_int) then
-        a_loadaddress_ref_reg(list,size,r,param_regs_int[nr])
-      else
-        begin
-          reset_reference(ref);
-          ref.base := stack_pointer;
-          ref.offset := LinkageAreaSize+para_size_till_now;
-          tmpreg := get_scratch_reg(list);
-          a_loadaddress_ref_reg(list,size,r,tmpreg);
-          a_load_reg_ref(list,size,tmpreg,ref);
-          free_scratch_reg(list,tmpreg);
-        end;
-{$endif para_sizes_known}
-    end;
-
-{ calling a code fragment by name }
-
-    procedure tcgppc.a_call_name(list : paasmoutput;const s : string;
-      offset : longint);
-
-      begin
- { save our RTOC register value. Only necessary when doing pointer based    }
- { calls or cross TOC calls, but currently done always                      }
-         list^.concat(new(paicpu,op_reg_ref(A_STW,R_RTOC,
-           new_reference(stack_pointer,LA_RTOC))));
-         list^.concat(new(paicpu,op_sym(A_BL,newasmsymbol(s))));
-         list^.concat(new(paicpu,op_reg_ref(A_LWZ,R_RTOC,
-           new_reference(stack_pointer,LA_RTOC))));
-      end;
-
-{********************** load instructions ********************}
-
-     procedure tcgppc.a_load_const_reg(list : paasmoutput; size: TCGSize; a : aword; reg : TRegister);
-
-       begin
-          If (a and $ffff) <> 0 Then
-            Begin
-              list^.concat(new(paicpu,op_reg_const(A_LI,reg,a and $ffff)));
-              If (a shr 16) <> 0 Then
-                list^.concat(new(paicpu,op_reg_const(A_ORIS,reg,a shr 16)))
-            End
-          Else
-            list^.concat(new(paicpu,op_reg_const(A_LIS,reg,a shr 16)));
-       end;
-
-     procedure tcgppc.a_load_reg_ref(list : paasmoutput; size: TCGSize; reg : tregister;const ref2 : treference);
-
-     Var
-       op: TAsmOp;
-       ref: TReference;
-
-       begin
-         ref := ref2;
-         FixRef(ref);
-         op := storeinstr[size,ref.index<>R_NO,false];
-         a_load_store(list,op,reg,ref);
-       End;
-
-     procedure tcgppc.a_load_ref_reg(list : paasmoutput;size : tcgsize;const ref2: treference;reg : tregister);
-
-     Var
-       op: TAsmOp;
-       tmpreg: tregister;
-       ref, tmpref: TReference;
-
-       begin
-         ref := ref2;
-         FixRef(ref);
-         op := loadinstr[size,ref.index<>R_NO,false];
-         a_load_store(list,op,reg,ref);
-       end;
-
-     procedure tcgppc.a_load_reg_reg(list : paasmoutput;size : tcgsize;reg1,reg2 : tregister);
-
-       begin
-         list^.concat(new(paicpu,op_reg_reg(A_MR,reg2,reg1)));
-       end;
-
-     procedure tcgppc.a_op_reg_const(list : paasmoutput; Op: TOpCG; size: TCGSize; reg: TRegister; a: AWord);
-
-     var scratch_register: TRegister;
-
-       begin
-         Case Op of
-           OP_DIV, OP_IDIV, OP_IMUL, OP_MUL:
-             If (Op = OP_IMUL) And (longint(a) >= -32768) And
-                (longint(a) <= 32767) Then
-               list^.concat(new(paicpu,op_reg_reg_const(A_MULLI,reg,reg,a)))
-             Else
-               Begin
-                 scratch_register := get_scratch_reg(list);
-                 a_load_const_reg(list, OS_32, a, scratch_register);
-                 list^.concat(new(paicpu,op_reg_reg_reg(TOpCG2AsmOpLo[Op],
-                   reg,reg,scratch_register)));
-                 free_scratch_reg(list,scratch_register);
-               End;
-           OP_ADD, OP_AND, OP_OR, OP_SUB,OP_XOR:
-             a_op_reg_reg_const32(list,TOpCG2AsmOpLo[Op],
-               TOpCG2AsmOpHi[Op],reg,reg,a);
-           OP_SHL,OP_SHR,OP_SAR:
-             Begin
-               if (a and 31) <> 0 Then
-                 list^.concat(new(paicpu,op_reg_reg_const(
-                   TOpCG2AsmOpLo[Op],reg,reg,a and 31)));
-               If (a shr 5) <> 0 Then
-                 InternalError(68991);
-             End
-           Else InternalError(68992);
-         end;
-       end;
-
-
-{*************** compare instructructions ****************}
-
-      procedure tcgppc.a_cmp_reg_const_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
-        l : pasmlabel);
-
-      var p: paicpu;
-          scratch_register: TRegister;
-          signed: boolean;
-
-        begin
-          signed := cmp_op in [OC_GT,OC_LT,OC_GTE,OC_LTE];
-          If signed Then
-            If (longint(a) >= -32768) and (longint(a) <= 32767) Then
-              list^.concat(new(paicpu,op_const_reg_const(A_CMPI,0,reg,a)))
-            else
-              begin
-                scratch_register := get_scratch_reg(list);
-                a_load_const_reg(list,OS_32,a,scratch_register);
-                list^.concat(new(paicpu,op_const_reg_reg(A_CMP,0,reg,scratch_register)));
-                free_scratch_reg(list,scratch_register);
-             end
-           else
-             if (a <= $ffff) then
-              list^.concat(new(paicpu,op_const_reg_const(A_CMPLI,0,reg,a)))
-            else
-              begin
-                scratch_register := get_scratch_reg(list);
-                a_load_const_reg(list,OS_32,a,scratch_register);
-                list^.concat(new(paicpu,op_const_reg_reg(A_CMPL,0,reg,scratch_register)));
-                free_scratch_reg(list,scratch_register);
-             end;
-           a_jmp(list,A_BC,TOpCmp2AsmCond[cmp_op],l);
-        end;
-
-
-      procedure tcgppc.a_cmp_reg_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;
-        reg1,reg2 : tregister;l : pasmlabel);
-
-      var p: paicpu;
-          op: tasmop;
-
-      begin
-        if cmp_op in [OC_GT,OC_LT,OC_GTE,OC_LTE] then
-          op := A_CMP
-        else op := A_CMPL;
-        list^.concat(new(paicpu,op_const_reg_reg(op,0,reg1,reg2)));
-        a_jmp(list,A_BC,TOpCmp2AsmCond[cmp_op],l);
-      end;
-
-     procedure tcgppc.a_jmp_cond(list : paasmoutput;cond : TOpCmp;l: pasmlabel);
-
-        begin
-          a_jmp(list,A_BC,TOpCmp2AsmCond[cond],l);
-        end;
-
-{ *********** entry/exit code and address loading ************ }
-
-    procedure tcgppc.g_stackframe_entry(list : paasmoutput;localsize : longint);
-    begin
-      case target_os.id of
-        os_powerpc_macos:
-          g_stackframe_entry_mac(list,localsize);
-        os_powerpc_linux:
-          g_stackframe_entry_sysv(list,localsize)
-        else
-          internalerror(2204001);
-      end;
-    end;
-
-
-    procedure tcgppc.g_stackframe_entry_sysv(list : paasmoutput;localsize : longint);
- { 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                                                                      }
-     var regcounter: TRegister;
-
-      begin
-        if (localsize mod 8) <> 0 then internalerror(58991);
- { 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,stack_pointer);
-        a_reg_alloc(list,R_0);
-        { allocate registers containing reg parameters }
-        for regcounter := R_3 to R_10 do
-          a_reg_alloc(list,regcounter);
-        { save return address... }
-        list^.concat(new(paicpu,op_reg_reg(A_MFSPR,R_0,R_LR)));
-        { ... in caller's frame }
-        list^.concat(new(paicpu,op_reg_ref(A_STW,R_0,new_reference(STACK_POINTER,4))));
-        a_reg_dealloc(list,R_0);
-        a_reg_alloc(list,R_11);
-        { save end of fpr save area }
-        list^.concat(new(paicpu,op_reg_reg_const(A_ORI,R_11,STACK_POINTER,0)));
-        a_reg_alloc(list,R_12);
-        { 0 or 8 based on SP alignment }
-        list^.concat(new(paicpu,op_reg_reg_const_const_const(A_RLWINM,
-          R_12,STACK_POINTER,0,28,28)));
-        { add in stack length }
-        list^.concat(new(paicpu,op_reg_reg_const(A_SUBFIC,R_12,R_12,
-          -localsize)));
-        { establish new alignment }
-        list^.concat(new(paicpu,op_reg_reg_reg(A_STWUX,STACK_POINTER,STACK_POINTER,R_12)));
-        a_reg_dealloc(list,R_12);
-        { save floating-point registers }
-        { !!! has to be optimized: only save registers that are used }
-        list^.concat(new(paicpu,op_sym_ofs(A_BL,newasmsymbol('_savefpr_14'),0)));
-        { compute end of gpr save area }
-        list^.concat(new(paicpu,op_reg_reg_const(A_ADDI,R_11,R_11,-144)));
-        { save gprs and fetch GOT pointer }
-        { !!! has to be optimized: only save registers that are used }
-        list^.concat(new(paicpu,op_sym_ofs(A_BL,newasmsymbol('_savegpr_14_go'),0)));
-        a_reg_alloc(list,R_31);
-        { place GOT ptr in r31 }
-        list^.concat(new(paicpu,op_reg_reg(A_MFSPR,R_31,R_LR)));
-        { save the CR if necessary ( !!! always done currently ) }
-        { still need to find out where this has to be done for SystemV
-        a_reg_alloc(list,R_0);
-        list^.concat(new(paicpu,op_reg_reg(A_MFSPR,R_0,R_CR);
-        list^.concat(new(paicpu,op_reg_ref(A_STW,scratch_register,
-          new_reference(stack_pointer,LA_CR))));
-        a_reg_dealloc(list,R_0); }
-        { save pointer to incoming arguments }
-        list^.concat(new(paicpu,op_reg_reg_const(A_ADDI,R_30,R_11,144)));
-        { now comes the AltiVec context save, not yet implemented !!! }
-       end;
-
-    procedure tcgppc.g_stackframe_entry_mac(list : paasmoutput;localsize : longint);
- { 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                                                                      }
-     var regcounter: TRegister;
-
-      begin
-        if (localsize mod 8) <> 0 then internalerror(58991);
- { 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,STACK_POINTER);
-        a_reg_alloc(list,R_0);
-        { allocate registers containing reg parameters }
-        for regcounter := R_3 to R_10 do
-          a_reg_alloc(list,regcounter);
-        { save return address... }
-        list^.concat(new(paicpu,op_reg_reg(A_MFSPR,R_0,R_LR)));
-        { ... in caller's frame }
-        list^.concat(new(paicpu,op_reg_ref(A_STW,R_0,new_reference(STACK_POINTER,8))));
-        a_reg_dealloc(list,R_0);
-        { save floating-point registers }
-        { !!! has to be optimized: only save registers that are used }
-        list^.concat(new(paicpu,op_sym_ofs(A_BL,newasmsymbol('_savef14'),0)));
-        { save gprs in gpr save area }
-        { !!! has to be optimized: only save registers that are used }
-        list^.concat(new(paicpu,op_reg_ref(A_STMW,R_13,new_reference(STACK_POINTER,-220))));
-        { save the CR if necessary ( !!! always done currently ) }
-        a_reg_alloc(list,R_0);
-        list^.concat(new(paicpu,op_reg_reg(A_MFSPR,R_0,R_CR)));
-        list^.concat(new(paicpu,op_reg_ref(A_STW,R_0,
-          new_reference(stack_pointer,LA_CR))));
-        a_reg_dealloc(list,R_0);
-        { save pointer to incoming arguments }
-        list^.concat(new(paicpu,op_reg_reg_const(A_ORI,R_31,STACK_POINTER,0)));
-        a_reg_alloc(list,R_12);
-        { 0 or 8 based on SP alignment }
-        list^.concat(new(paicpu,op_reg_reg_const_const_const(A_RLWINM,
-          R_12,STACK_POINTER,0,28,28)));
-        { add in stack length }
-        list^.concat(new(paicpu,op_reg_reg_const(A_SUBFIC,R_12,R_12,
-          -localsize)));
-        { establish new alignment }
-        list^.concat(new(paicpu,op_reg_reg_reg(A_STWUX,STACK_POINTER,STACK_POINTER,R_12)));
-        a_reg_dealloc(list,R_12);
-        { now comes the AltiVec context save, not yet implemented !!! }
-       end;
-
-
-    procedure tcgppc.g_restore_frame_pointer(list : paasmoutput);
-
-      begin
- { no frame pointer on the PowerPC (maybe there is one in the SystemV ABI?)}
-      end;
-
-    procedure tcgppc.g_return_from_proc(list : paasmoutput;parasize : aword);
-    begin
-      case target_os.id of
-        os_powerpc_macos:
-          g_return_from_proc_mac(list,parasize);
-        os_powerpc_linux:
-          g_return_from_proc_sysv(list,parasize)
-        else
-          internalerror(2204001);
-      end;
-    end;
-
-
-     procedure tcgppc.g_return_from_proc_sysv(list : paasmoutput;parasize : aword);
-
-     var regcounter: TRegister;
-
-     begin
-       { release parameter registers }
-       for regcounter := R_3 to R_10 do
-         a_reg_dealloc(list,regcounter);
-       { AltiVec context restore, not yet implemented !!! }
-
-       { address of gpr save area to r11 }
-       list^.concat(new(paicpu,op_reg_reg_const(A_ADDI,R_11,R_31,-144)));
-       { restore gprs }
-       list^.concat(new(paicpu,op_sym_ofs(A_BL,newasmsymbol('_restgpr_14'),0)));
-       { address of fpr save area to r11 }
-       list^.concat(new(paicpu,op_reg_reg_const(A_ADDI,R_11,R_11,144)));
-       { restore fprs and return }
-       list^.concat(new(paicpu,op_sym_ofs(A_BL,newasmsymbol('_restfpr_14_x'),0)));
-     end;
-
-     procedure tcgppc.g_return_from_proc_mac(list : paasmoutput;parasize : aword);
-
-     var regcounter: TRegister;
-
-     begin
-       { release parameter registers }
-       for regcounter := R_3 to R_10 do
-         a_reg_dealloc(list,regcounter);
-       { AltiVec context restore, not yet implemented !!! }
-
-       { restore SP }
-       list^.concat(new(paicpu,op_reg_reg_const(A_ORI,STACK_POINTER,R_31,0)));
-       { restore gprs }
-       list^.concat(new(paicpu,op_reg_ref(A_LMW,R_13,new_reference(STACK_POINTER,-220))));
-       { restore return address ... }
-       list^.concat(new(paicpu,op_reg_ref(A_LWZ,R_0,new_reference(STACK_POINTER,8))));
-       { ... and return from _restf14 }
-       list^.concat(new(paicpu,op_sym_ofs(A_B,newasmsymbol('_restf14'),0)));
-     end;
-
-     procedure tcgppc.a_loadaddress_ref_reg(list : paasmoutput;const ref2 : treference;r : tregister);
-
-     var tmpreg: tregister;
-         ref, tmpref: treference;
-
-       begin
-         ref := ref2;
-         FixRef(ref);
-         if assigned(ref.symbol) then
-           { add the symbol's value to the base of the reference, and if the }
-           { reference doesn't have a base, create one                       }
-           begin
-             tmpreg := get_scratch_reg(list);
-             reset_reference(tmpref);
-             tmpref.symbol := ref.symbol;
-             tmpref.symaddr := refs_ha;
-             tmpref.is_immediate := true;
-             if ref.base <> R_NO then
-               list^.concat(new(paicpu,op_reg_reg_ref(A_ADDIS,tmpreg,
-                 ref.base,newreference(tmpref))))
-             else
-               list^.concat(new(paicpu,op_reg_ref(A_LIS,tmpreg,
-                  newreference(tmpref))));
-             ref.base := tmpreg;
-             ref.symaddr := refs_l;
-             { can be folded with one of the next instructions by the }
-             { optimizer probably                                     }
-             list^.concat(new(paicpu,op_reg_reg_ref(A_ADDI,tmpreg,tmpreg,
-                newreference(tmpref))));
-           end;
-         if ref.offset <> 0 Then
-           if ref.base <> R_NO then
-             a_op_reg_reg_const32(list,A_ADDI,A_ADDIS,r,r,ref.offset)
-  { FixRef makes sure that "(ref.index <> R_NO) and (ref.offset <> 0)" never}
-  { occurs, so now only ref.offset has to be loaded                         }
-           else a_load_const_reg(list, OS_32, ref.offset, r)
-         else
-           if ref.index <> R_NO Then
-             list^.concat(new(paicpu,op_reg_reg_reg(A_ADD,r,ref.base,ref.index)))
-           else list^.concat(new(paicpu,op_reg_reg(A_MR,r,ref.base)));
-         if assigned(ref.symbol) then
-           free_scratch_reg(list,tmpreg);
-       end;
-
-
-{ ************* concatcopy ************ }
-
-    procedure tcgppc.g_concatcopy(list : paasmoutput;const source,dest : treference;len : aword;loadref : boolean);
-
-    var
-      p: paicpu;
-      countreg, tempreg: TRegister;
-      src, dst: TReference;
-      lab: PAsmLabel;
-      count, count2: aword;
-      begin
-        { make sure source and dest are valid }
-        src := source;
-        fixref(src);
-        dst := dest;
-        fixref(dst);
-        reset_reference(src);
-        reset_reference(dst);
-        { load the address of source into src.base }
-        src.base := get_scratch_reg(list);
-        if loadref then
-          a_load_ref_reg(list,OS_32,source,src.base)
-        else a_loadaddress_ref_reg(list,source,src.base);
-        { load the address of dest into dst.base }
-        dst.base := get_scratch_reg(list);
-        a_loadaddress_ref_reg(list,dest,dst.base);
-        count := len div 4;
-        if count > 3 then
-          { generate a loop }
-          begin
-            { the offsets are zero after the a_loadaddress_ref_reg and just }
-            { have to be set to 4. 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 genreated assembler                     }
-            Inc(dst.offset,4);
-            Inc(src.offset,4);
-            a_op_reg_reg_const32(list,A_SUBI,A_NONE,src.base,src.base,4);
-            a_op_reg_reg_const32(list,A_SUBI,A_NONE,dst.base,dst.base,4);
-            countreg := get_scratch_reg(list);
-            a_load_const_reg(list,OS_32,count-1,countreg);
-            { explicitely allocate R_0 since it can be used safely here }
-            { (for holding date that's being copied)                    }
-            tempreg := R_0;
-            a_reg_alloc(list,R_0);
-            getlabel(lab);
-            a_label(list, lab);
-            list^.concat(new(paicpu,op_reg_ref(A_LWZU,tempreg,
-              newreference(src))));
-            a_op_reg_reg_const32(list,A_CMPI,A_NONE,R_CR0,countreg,0);
-            list^.concat(new(paicpu,op_reg_ref(A_STWU,tempreg,
-              newreference(dst))));
-            a_op_reg_reg_const32(list,A_SUBI,A_NONE,countreg,countreg,1);
-            a_jmp(list,A_BC,CF_NE,lab);
-            free_scratch_reg(list,countreg);
-          end
-        else
-          { unrolled loop }
-          begin
-            tempreg := get_scratch_reg(list);
-            for count2 := 1 to count do
-              begin
-                a_load_ref_reg(list,OS_32,src,tempreg);
-                a_load_reg_ref(list,OS_32,tempreg,dst);
-                inc(src.offset,4);
-                inc(dst.offset,4);
-              end
-          end;
-       { copy the leftovers }
-       if (len and 2) <> 0 then
-         begin
-           a_load_ref_reg(list,OS_16,src,tempreg);
-           a_load_reg_ref(list,OS_16,tempreg,dst);
-           inc(src.offset,2);
-           inc(dst.offset,2);
-         end;
-       if (len and 1) <> 0 then
-         begin
-           a_load_ref_reg(list,OS_8,src,tempreg);
-           a_load_reg_ref(list,OS_8,tempreg,dst);
-         end;
-       a_reg_dealloc(list,tempreg);
-       free_scratch_reg(list,src.base);
-       free_scratch_reg(list,dst.base);
-      end;
-
-{***************** This is private property, keep out! :) *****************}
-
-    procedure tcgppc.fixref(var ref: treference);
-
-       begin
-         If (ref.base <> R_NO) then
-           begin
-             if (ref.index <> R_NO) and
-                ((ref.offset <> 0) or assigned(ref.symbol)) Then
-               Internalerror(58992)
-           end
-         else
-           begin
-             ref.base := ref.index;
-             ref.index := R_NO
-           end
-       end;
-
-    procedure tcgppc.a_op_reg_reg_const32(list: paasmoutput; oplo, ophi:
-                       tasmop; reg1, reg2: tregister; a: aword);
-
-      begin
-        if (a and $ffff) <> 0 Then
-          list^.concat(new(paicpu,op_reg_reg_const(OpLo,reg1,reg2,a and $ffff)));
-        If (a shr 16) <> 0 Then
-          list^.concat(new(paicpu,op_reg_reg_const(OpHi,reg1,reg2,a shr 16)))
-      end;
-
-    procedure tcgppc.a_load_store(list:paasmoutput;op: tasmop;reg:tregister;
-                       var ref: treference);
-
-    var tmpreg: tregister;
-        tmpref: treference;
-
-      begin
-        if assigned(ref.symbol) then
-          begin
-            tmpreg := get_scratch_reg(list);
-            reset_reference(tmpref);
-            tmpref.symbol := ref.symbol;
-            tmpref.symaddr := refs_ha;
-            tmpref.is_immediate := true;
-            if ref.base <> R_NO then
-              list^.concat(new(paicpu,op_reg_reg_ref(A_ADDIS,tmpreg,
-                ref.base,newreference(tmpref))))
-            else
-              list^.concat(new(paicpu,op_reg_ref(A_LIS,tmpreg,
-                 newreference(tmpref))));
-            ref.base := tmpreg;
-            ref.symaddr := refs_l;
-          end;
-        list^.concat(new(paicpu,op_reg_ref(op,reg,newreference(ref))));
-        if assigned(ref.symbol) then
-          free_scratch_reg(list,tmpreg);
-      end;
-
-    procedure tcgppc.a_jmp(list: paasmoutput; op: tasmop; c: tasmcondflags;
-                l: pasmlabel);
-    var p: paicpu;
-    begin
-      p := new(paicpu,op_sym(op,newasmsymbol(l^.name)));
-      create_cond_norm(c,0,p^.condition);
-      list^.concat(p)
-    end;
-
-end.
-{
-  $Log$
-  Revision 1.2  2001-08-26 13:29:33  florian
-    * some cg reorganisation
-    * some PPC updates
-
-  Revision 1.1  2000/07/13 06:30:12  michael
-    + Initial import
-
-  Revision 1.12  2000/04/22 14:25:04  jonas
-    * aasm.pas: pai_align instead of pai_align_abstract if cpu <> i386
-    + systems.pas: info for macos/ppc
-    * new/cgobj.pas: compiles again without newst define
-    * new/powerpc/cgcpu: generate different entry/exit code depending on
-      whether target_os is MacOs or Linux
-
-  Revision 1.11  2000/01/07 01:14:57  peter
-    * updated copyright to 2000
-
-  Revision 1.10  1999/12/24 22:48:10  jonas
-    * compiles again
-
-  Revision 1.9  1999/11/05 07:05:56  jonas
-    + a_jmp_cond()
-
-  Revision 1.8  1999/10/24 09:22:18  jonas
-    + entry/exitcode for SystemV (Linux) and AIX/Mac from the Altivec
-      PIM (no AltiVec support yet though)
-    * small fix to the a_cmp_* methods
-
-  Revision 1.7  1999/10/20 12:23:24  jonas
-    * fixed a_loadaddress_ref_reg (mentioned as ToDo in rev. 1.5)
-    * small bugfix in a_load_store
-
-  Revision 1.6  1999/09/15 20:35:47  florian
-    * small fix to operator overloading when in MMX mode
-    + the compiler uses now fldz and fld1 if possible
-    + some fixes to floating point registers
-    + some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
-    * .... ???
-
-  Revision 1.5  1999/09/03 13:14:11  jonas
-    + implemented some parameter passing methods, but they require
-      some more helper routines
-    * fix for loading symbol addresses (still needs to be done in a_loadaddress)
-    * several changes to the way conditional branches are handled
-
-  Revision 1.4  1999/08/26 14:53:41  jonas
-    * first implementation of concatcopy (requires 4 scratch regs)
-
-  Revision 1.3  1999/08/25 12:00:23  jonas
-    * changed pai386, paippc and paiapha (same for tai*) to paicpu (taicpu)
-
-  Revision 1.2  1999/08/18 17:05:57  florian
-    + implemented initilizing of data for the new code generator
-      so it should compile now simple programs
-
-  Revision 1.1  1999/08/06 16:41:11  jonas
-    * PowerPC compiles again, several routines implemented in cgcpu.pas
-    * added constant to cpubase of alpha and powerpc for maximum
-      number of operands
-}

compiler/new/powerpc/cpuasm.pas

@@ -1,438 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1999-2001 by Jonas Maebe
-
-    Contains the assembler object 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 cpuasm;
-
-interface
-
-uses
-  cclasses,
-  aasm,globals,verbose,tainst,
-  cpubase;
-
-type
-
-  taicpu = class(tainstruction)
-     constructor op_none(op : tasmop);
-
-     constructor op_reg(op : tasmop;_op1 : tregister);
-     constructor op_const(op : tasmop;_op1 : longint);
-
-     constructor op_reg_reg(op : tasmop;_op1,_op2 : tregister);
-     constructor op_reg_ref(op : tasmop;_op1 : tregister;_op2 : preference);
-     constructor op_reg_const(op:tasmop; _op1: tregister; _op2: longint);
-     constructor op_const_reg(op:tasmop; _op1: longint; _op2: tregister);
-
-     constructor op_const_const(op : tasmop;_op1,_op2 : longint);
-
-     constructor op_reg_reg_reg(op : tasmop;_op1,_op2,_op3 : tregister);
-     constructor op_reg_reg_const(op : tasmop;_op1,_op2 : tregister; _op3: Longint);
-     constructor op_reg_reg_sym_ofs(op : tasmop;_op1,_op2 : tregister; _op3: tasmsymbol;_op3ofs: longint);
-     constructor op_reg_reg_ref(op : tasmop;_op1,_op2 : tregister; _op3: preference);
-     constructor op_const_reg_reg(op : tasmop;_op1 : longint;_op2, _op3 : tregister);
-     constructor op_const_reg_const(op : tasmop;_op1 : longint;_op2 : tregister;_op3 : longint);
-
-     constructor op_reg_reg_reg_reg(op : tasmop;_op1,_op2,_op3,_op4 : tregister);
-     constructor op_reg_bool_reg_reg(op : tasmop;_op1: tregister;_op2:boolean;_op3,_op4:tregister);
-     constructor op_reg_bool_reg_const(op : tasmop;_op1: tregister;_op2:boolean;_op3:tregister;_op4: longint);
-
-     constructor op_reg_reg_const_const_const(op : tasmop;_op1,_op2 : tregister;_op3,_op4,_op5 : Longint);
-
-
-     { this is for Jmp instructions }
-     constructor op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : tasmsymbol);
-     constructor op_const_const_sym(op : tasmop;_op1,_op2 : longint;_op3: tasmsymbol);
-
-
-     constructor op_sym(op : tasmop;_op1 : tasmsymbol);
-     constructor op_sym_ofs(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint);
-     constructor op_reg_sym_ofs(op : tasmop;_op1 : tregister;_op2:tasmsymbol;_op2ofs : longint);
-     constructor op_sym_ofs_ref(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;_op2 : preference);
-
-     procedure loadbool(opidx:longint;_b:boolean);
-     procedure loadconst(opidx:longint;l:longint);
-     procedure loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
-     procedure loadref(opidx:longint;p:preference);
-     procedure loadreg(opidx:longint;r:tregister);
-     procedure loadoper(opidx:longint;o:toper);
-
-     destructor destroy;override;
-  end;
-
-
-implementation
-
-{*****************************************************************************
-                                 taicpu Constructors
-*****************************************************************************}
-
-    procedure taicpu.loadconst(opidx:longint;l:longint);
-      begin
-        if opidx>=ops then
-         ops:=opidx+1;
-        with oper[opidx] do
-         begin
-           if typ=top_ref then
-            disposereference(ref);
-           val:=l;
-           typ:=top_const;
-         end;
-      end;
-
-
-    procedure taicpu.loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
-      begin
-        if opidx>=ops then
-         ops:=opidx+1;
-        with oper[opidx] do
-         begin
-           if typ=top_ref then
-            disposereference(ref);
-           sym:=s;
-           symofs:=sofs;
-           typ:=top_symbol;
-         end;
-        { Mark the symbol as used }
-        if assigned(s) then
-         inc(s.refs);
-      end;
-
-
-    procedure taicpu.loadref(opidx:longint;p:preference);
-      begin
-        if opidx>=ops then
-         ops:=opidx+1;
-        with oper[opidx] do
-         begin
-           if typ=top_ref then
-            disposereference(ref);
-           if p^.is_immediate then
-             begin
-{$ifdef REF_IMMEDIATE_WARN}
-               Comment(V_Warning,'Reference immediate');
-{$endif}
-               val:=p^.offset;
-               disposereference(p);
-               typ:=top_const;
-             end
-           else
-             begin
-               ref:=p;
-               typ:=top_ref;
-               { mark symbol as used }
-               if assigned(ref^.symbol) then
-                 inc(ref^.symbol.refs);
-             end;
-         end;
-      end;
-
-
-    procedure taicpu.loadreg(opidx:longint;r:tregister);
-      begin
-        if opidx>=ops then
-         ops:=opidx+1;
-        with oper[opidx] do
-         begin
-           if typ=top_ref then
-            disposereference(ref);
-           reg:=r;
-           typ:=top_reg;
-         end;
-      end;
-
-    procedure taicpu.loadoper(opidx:longint;o:toper);
-      begin
-        if opidx>=ops then
-         ops:=opidx+1;
-        if oper[opidx].typ=top_ref then
-          disposereference(oper[opidx].ref);
-        oper[opidx]:=o;
-        { copy also the reference }
-        if oper[opidx].typ=top_ref then
-         oper[opidx].ref:=newreference(o.ref^);
-      end;
-
-
-    procedure taicpu.loadbool(opidx:longint;_b:boolean);
-      begin
-        if opidx>=ops then
-         ops:=opidx+1;
-        with oper[opidx] do
-         begin
-           if typ=top_ref then
-            disposereference(ref);
-           b:=_b;
-           typ:=top_bool;
-         end;
-      end;
-
-
-    constructor taicpu.op_none(op : tasmop);
-      begin
-         inherited create(op);
-      end;
-
-
-    constructor taicpu.op_reg(op : tasmop;_op1 : tregister);
-      begin
-         inherited create(op);
-         ops:=1;
-         loadreg(0,_op1);
-      end;
-
-
-    constructor taicpu.op_const(op : tasmop;_op1 : longint);
-      begin
-         inherited create(op);
-         ops:=1;
-         loadconst(0,_op1);
-      end;
-
-
-    constructor taicpu.op_reg_reg(op : tasmop;_op1,_op2 : tregister);
-      begin
-         inherited create(op);
-         ops:=2;
-         loadreg(0,_op1);
-         loadreg(1,_op2);
-      end;
-
-    constructor taicpu.op_reg_const(op:tasmop; _op1: tregister; _op2: longint);
-      begin
-         inherited create(op);
-         ops:=2;
-         loadreg(0,_op1);
-         loadconst(1,_op2);
-      end;
-
-     constructor taicpu.op_const_reg(op:tasmop; _op1: longint; _op2: tregister);
-      begin
-         inherited create(op);
-         ops:=2;
-         loadconst(0,_op1);
-         loadreg(1,_op2);
-      end;
-
-
-    constructor taicpu.op_reg_ref(op : tasmop;_op1 : tregister;_op2 : preference);
-      begin
-         inherited create(op);
-         ops:=2;
-         loadreg(0,_op1);
-         loadref(1,_op2);
-      end;
-
-
-    constructor taicpu.op_const_const(op : tasmop;_op1,_op2 : longint);
-      begin
-         inherited create(op);
-         ops:=2;
-         loadconst(0,_op1);
-         loadconst(1,_op2);
-      end;
-
-
-    constructor taicpu.op_reg_reg_reg(op : tasmop;_op1,_op2,_op3 : tregister);
-      begin
-         inherited create(op);
-         ops:=3;
-         loadreg(0,_op1);
-         loadreg(1,_op2);
-         loadreg(2,_op3);
-      end;
-
-     constructor taicpu.op_reg_reg_const(op : tasmop;_op1,_op2 : tregister; _op3: Longint);
-       begin
-         inherited create(op);
-         ops:=3;
-         loadreg(0,_op1);
-         loadreg(1,_op2);
-         loadconst(2,_op3);
-      end;
-
-     constructor taicpu.op_reg_reg_sym_ofs(op : tasmop;_op1,_op2 : tregister; _op3: tasmsymbol;_op3ofs: longint);
-       begin
-         inherited create(op);
-         ops:=3;
-         loadreg(0,_op1);
-         loadreg(1,_op2);
-         loadsymbol(0,_op3,_op3ofs);
-      end;
-
-     constructor taicpu.op_reg_reg_ref(op : tasmop;_op1,_op2 : tregister;  _op3: preference);
-       begin
-         inherited create(op);
-         ops:=3;
-         loadreg(0,_op1);
-         loadreg(1,_op2);
-         loadref(2,_op3);
-      end;
-
-    constructor taicpu.op_const_reg_reg(op : tasmop;_op1 : longint;_op2, _op3 : tregister);
-      begin
-         inherited create(op);
-         ops:=3;
-         loadconst(0,_op1);
-         loadreg(1,_op2);
-         loadreg(2,_op3);
-      end;
-
-     constructor taicpu.op_const_reg_const(op : tasmop;_op1 : longint;_op2 : tregister;_op3 : longint);
-      begin
-         inherited create(op);
-         ops:=3;
-         loadconst(0,_op1);
-         loadreg(1,_op2);
-         loadconst(2,_op3);
-      end;
-
-
-     constructor taicpu.op_reg_reg_reg_reg(op : tasmop;_op1,_op2,_op3,_op4 : tregister);
-      begin
-         inherited create(op);
-         ops:=4;
-         loadreg(0,_op1);
-         loadreg(1,_op2);
-         loadreg(2,_op3);
-         loadreg(3,_op4);
-      end;
-
-     constructor taicpu.op_reg_bool_reg_reg(op : tasmop;_op1: tregister;_op2:boolean;_op3,_op4:tregister);
-      begin
-         inherited create(op);
-         ops:=4;
-         loadreg(0,_op1);
-         loadbool(1,_op2);
-         loadreg(2,_op3);
-         loadreg(3,_op4);
-      end;
-
-     constructor taicpu.op_reg_bool_reg_const(op : tasmop;_op1: tregister;_op2:boolean;_op3:tregister;_op4: longint);
-      begin
-         inherited create(op);
-         ops:=4;
-         loadreg(0,_op1);
-         loadbool(0,_op2);
-         loadreg(0,_op3);
-         loadconst(0,_op4);
-      end;
-
-     constructor taicpu.op_reg_reg_const_const_const(op : tasmop;_op1,_op2 : tregister;_op3,_op4,_op5 : Longint);
-      begin
-         inherited create(op);
-         ops:=5;
-         loadreg(0,_op1);
-         loadreg(1,_op2);
-         loadconst(2,_op3);
-         loadconst(3,_op4);
-         loadconst(4,_op5);
-      end;
-
-    constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : tasmsymbol);
-      begin
-         inherited create(op);
-         condition:=cond;
-         ops:=1;
-         loadsymbol(0,_op1,0);
-      end;
-
-     constructor taicpu.op_const_const_sym(op : tasmop;_op1,_op2 : longint; _op3: tasmsymbol);
-      begin
-         inherited create(op);
-         ops:=3;
-         loadconst(0,_op1);
-         loadconst(1,_op2);
-         loadsymbol(2,_op3,0);
-      end;
-
-
-    constructor taicpu.op_sym(op : tasmop;_op1 : tasmsymbol);
-      begin
-         inherited create(op);
-         ops:=1;
-         loadsymbol(0,_op1,0);
-      end;
-
-
-    constructor taicpu.op_sym_ofs(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint);
-      begin
-         inherited create(op);
-         ops:=1;
-         loadsymbol(0,_op1,_op1ofs);
-      end;
-
-
-     constructor taicpu.op_reg_sym_ofs(op : tasmop;_op1 : tregister;_op2:tasmsymbol;_op2ofs : longint);
-      begin
-         inherited create(op);
-         ops:=2;
-         loadreg(0,_op1);
-         loadsymbol(1,_op2,_op2ofs);
-      end;
-
-
-    constructor taicpu.op_sym_ofs_ref(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;_op2 : preference);
-      begin
-         inherited create(op);
-         ops:=2;
-         loadsymbol(0,_op1,_op1ofs);
-         loadref(1,_op2);
-      end;
-
-    destructor taicpu.destroy;
-      var
-        i : longint;
-      begin
-          for i:=ops-1 downto 0 do
-            if (oper[i].typ=top_ref) then
-              dispose(oper[i].ref);
-        inherited destroy;
-      end;
-
-end.
-{
-  $Log$
-  Revision 1.2  2001-08-26 13:29:34  florian
-    * some cg reorganisation
-    * some PPC updates
-
-  Revision 1.1  2000/07/13 06:30:12  michael
-    + Initial import
-
-  Revision 1.5  2000/01/07 01:14:58  peter
-    * updated copyright to 2000
-
-  Revision 1.4  1999/08/25 12:00:24  jonas
-    * changed pai386, paippc and paiapha (same for tai*) to paicpu (taicpu)
-
-  Revision 1.3  1999/08/06 16:41:11  jonas
-    * PowerPC compiles again, several routines implemented in cgcpu.pas
-    * added constant to cpubase of alpha and powerpc for maximum
-      number of operands
-
-  Revision 1.2  1999/08/04 12:59:24  jonas
-    * all tokes now start with an underscore
-    * PowerPC compiles!!
-
-  Revision 1.1  1999/08/03 23:37:53  jonas
-    + initial implementation for PowerPC based on the Alpha stuff
-}

compiler/new/powerpc/cpubase.pas

@@ -1,663 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 by Florian Klaempfl
-
-    Contains the base types 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 cpubase;
-
-{$i defines.inc}
-
-interface
-
-uses
-  strings,cutils,cclasses,aasm,cpuinfo;
-
-{$ifndef NOOPT}
-Type
-{What an instruction can change}
-  TInsChange = (Ch_None);
-{$endif}
-
-const
-{ Size of the instruction table converted by nasmconv.pas }
-  instabentries = 1103;
-  maxinfolen    = 7;
-
-{ By default we want everything }
-{$define ATTOP}
-{$define ATTREG}
-{$define INTELOP}
-{$define ITTABLE}
-
-{ For TP we can't use asmdebug due the table sizes }
-{$ifndef TP}
-  {$define ASMDEBUG}
-{$endif}
-
-{ We Don't need the intel style opcodes if we don't have a intel }
-{ reader or generator                                            }
-{$undef INTELOP}
-
-{ We Don't need the AT&T style opcodes if we don't have a AT&T
-  reader or generator }
-{$ifdef NORA386ATT}
-  {$ifdef NOAG386ATT}
-    {$undef ATTOP}
-    {$ifdef NOAG386DIR}
-       {$undef ATTREG}
-    {$endif}
-  {$endif}
-{$endif}
-
-type
-  TAsmOp=(A_None,
-    { normal opcodes }
-    a_add, a_add_, a_addo, a_addo_, a_addc, a_addc_, a_addco, a_addco_,
-    a_adde, a_adde_, a_addeo, a_addeo_, a_addi, a_addic, a_addic_, a_addis,
-    a_addme, a_addme_, a_addmeo, a_addmeo_, a_addze, a_addze_, a_addzeo,
-    a_addzeo_, a_and, a_and_, a_andc, a_andc_, a_andi_, a_andis_, a_b,
-    a_ba, a_bl, a_bla, a_bc, a_bca, a_bcl, a_bcla, a_bcctr, a_bcctrl, a_bclr,
-    a_bclrl, a_cmp, a_cmpi, a_cmpl, a_cmpli, a_cntlzw, a_cntlzw_, a_crand,
-    a_crandc, a_creqv, a_crnand, a_crnor, a_cror, a_crorc, a_crxor, a_dcba,
-    a_dcbf, a_dcbi, a_dcbst, a_dcbt, a_divw, a_divw_, a_divwo, a_divwo_,
-    a_divwu, a_divwu_, a_divwuo, a_divwuo_, a_eciwx, a_ecowx, a_eieio, a_eqv,
-    a_eqv_, a_extsb, a_extsb_, a_extsh, a_extsh_, a_fabs, a_fabs_, a_fadd,
-    a_fadd_, a_fadds, a_fadds_, a_fcompo, a_fcmpu, a_fctiw, a_fctw_, a_fctwz,
-    a_fctwz_, a_fdiv, a_fdiv_, a_fdivs, a_fdivs_, a_fmadd, a_fmadd_, a_fmadds,
-    a_fmadds_, a_fmr, a_fmsub, a_fmsub_, a_fmsubs, a_fmsubs_, a_fmul, a_fmul_,
-    a_fmuls, a_fmuls_, a_fnabs, a_fnabs_, a_fneg, a_fneg_, a_fnmadd,
-    a_fnmadd_, a_fnmadds, a_fnmadds_, a_fnmsub, a_fnmsub_, a_fnmsubs,
-    a_fnmsubs_, a_fres, a_fres_, a_frsp, a_frsp_, a_frsqrte, a_frsqrte_,
-    a_fsel, a_fsel_, a_fsqrt, a_fsqrt_, a_fsqrts, a_fsqrts_, a_fsub, a_fsub_,
-    a_fsubs, a_fsubs_, a_icbi, a_isync, a_lbz, a_lbzu, a_lbzux, a_lbzx,
-    a_lfd, a_lfdu, a_lfdux, a_lfdx, a_lfs, a_lfsu, a_lfsux, a_lfsx, a_lha,
-    a_lhau, a_lhaux, a_lhax, a_hbrx, a_lhz, a_lhzu, a_lhzux, a_lhzx, a_lmw,
-    a_lswi, a_lswx, a_lwarx, a_lwbrx, a_lwz, a_lwzu, a_lwzux, a_lwzx, a_mcrf,
-    a_mcrfs, a_lcrxe, a_mfcr, a_mffs, a_maffs_, a_mfmsr, a_mfspr, a_mfsr,
-    a_mfsrin, a_mftb, a_mtfcrf, a_a_mtfd0, a_mtfsb1, a_mtfsf, a_mtfsf_,
-    a_mtfsfi, a_mtfsfi_, a_mtmsr, a_mtspr, a_mtsr, a_mtsrin, a_mulhw,
-    a_mulhw_, a_mulhwu, a_mulhwu_, a_mulli, a_mullw, a_mullw_, a_mullwo,
-    a_mullwo_, a_nand, a_nand_, a_neg, a_neg_, a_nego, a_nego_, a_nor, a_nor_,
-    a_or, a_or_, a_orc, a_orc_, a_ori, a_oris, a_rfi, a_rlwimi, a_rlwimi_,
-    a_rlwinm, a_tlwinm_, a_rlwnm, a_sc, a_slw, a_slw_, a_sraw, a_sraw_,
-    a_srawi, a_srawi_,a_srw, a_srw_, a_stb, a_stbu, a_stbux, a_stbx, a_stfd,
-    a_stfdu, a_stfdux, a_stfdx, a_stfiwx, a_stfs, a_stfsu, a_stfsux, a_stfsx,
-    a_sth, a_sthbrx, a_sthu, a_sthux, a_sthx, a_stmw, a_stswi, a_stswx, a_stw,
-    a_stwbrx, a_stwx_, a_stwu, a_stwux, a_stwx, a_subf, a_subf_, a_subfo,
-    a_subfo_, a_subfc, a_subfc_, a_subfco, a_subfco_, a_subfe, a_subfe_,
-    a_subfeo, a_subfeo_, a_subfic, a_subfme, a_subfme_, a_subfmeo, a_subfmeo_,
-    a_subfze, a_subfze_, a_subfzeo, a_subfzeo_, a_sync, a_tlbia, a_tlbie,
-    a_tlbsync, a_tw, a_twi, a_xor, a_xor_, a_xori, a_xoris,
-    { simplified mnemonics }
-    a_subi, a_subis, a_subic, a_subic_, a_sub, a_sub_, a_subo, a_subo_,
-    a_subc, a_subc_, a_subco, _subco_, a_cmpwi, a_cmpw, a_cmplwi, a_cmplw,
-    a_extlwi, a_extlwi_, a_extrwi, a_extrwi_, a_inslwi, a_inslwi_, a_insrwi,
-    a_insrwi_, a_rotlwi, a_rotlwi_, a_rotlw, a_rotlw_, a_slwi, a_slwi_,
-    a_srwi, a_srwi_, a_clrlwi, a_clrlwi_, a_clrrwi, a_clrrwi_, a_clrslwi,
-    a_clrslwi_, a_blr, a_bctr, a_blrl, a_bctrl, a_crset, a_crclr, a_crmove,
-    a_crnot, a_mt {move to special prupose reg}, a_mf {move from special purpose reg},
-    a_nop, a_li, a_lis, a_la, a_mr, a_not, a_mtcr);
-
-  op2strtable=array[tasmop] of string[8];
-
-const
-  firstop = low(tasmop);
-  lastop  = high(tasmop);
-
-
-{*****************************************************************************
-                                  Registers
-*****************************************************************************}
-
-type
-  tregister = (R_NO,
-    R_0,R_1,R_2,R_3,R_4,R_5,R_6,R_7,R_8,R_9,R_10,R_11,R_12,R_13,R_14,R_15,R_16,
-    R_17,R_18,R_19,R_20,R_21,R_22,R_23,R_24,R_25,R_26,R_27,R_28,R_29,R_30,R_31,
-    R_F0,R_F1,R_F2,R_F3,R_F4,R_F5,R_F6,R_F7,R_F8,R_F9,R_F10,R_F11,R_F12,
-    R_F13,R_F14,R_F15,R_F16,R_F17, R_F18,R_F19,R_F20,R_F21,R_F22, R_F23,R_F24,
-    R_F25,R_F26,R_F27,R_F28,R_F29,R_F30,R_F31,
-    R_M0,R_M1,R_M2,R_M3,R_M4,R_M5,R_M6,R_M7,R_M8,R_M9,R_M10,R_M11,R_M12,
-    R_M13,R_M14,R_M15,R_M16,R_M17,R_M18,R_M19,R_M20,R_M21,R_M22, R_M23,R_M24,
-    R_M25,R_M26,R_M27,R_M28,R_M29,R_M30,R_M31,
-
-    R_CR,R_CR0,R_CR1,R_CR2,R_CR3,R_CR4,R_CR5,R_CR6,R_CR7,
-    R_XER,R_LR,R_CTR,R_FPSCR
-  );
-
-  tregisterset = set of tregister;
-
-  reg2strtable = array[tregister] of string[5];
-
-Const
-   R_SPR1 = R_XER;
-   R_SPR8 = R_LR;
-   R_SPR9 = R_CTR;
-   R_TOC = R_2;
-{   CR0 = 0;
-   CR1 = 4;
-   CR2 = 8;
-   CR3 = 12;
-   CR4 = 16;
-   CR5 = 20;
-   CR6 = 24;
-   CR7 = 28;
-   LT = 0;
-   GT = 1;
-   EQ = 2;
-   SO = 3;
-   FX = 4;
-   FEX = 5;
-   VX = 6;
-   OX = 7;}
-
-  firstreg = low(tregister);
-  lastreg  = high(tregister);
-
-  att_reg2str : reg2strtable = ('',
-    '0','1','2','3','4','5','6','7','8','9','10','11','12','13','14','15','16',
-    '17','18','19','20','21','22','23','24','25','26','27','28','29','30','31',
-    'F0','F1','F2','F3','F4','F5','F6','F7', 'F8','F9','F10','F11','F12',
-    'F13','F14','F15','F16','F17', 'F18','F19','F20','F21','F22', 'F23','F24',
-    'F25','F26','F27','F28','F29','F30','F31',
-    'M0','M1','M2','M3','M4','M5','M6','M7','M8','M9','M10','M11','M12',
-    'M13','M14','M15','M16','M17','M18','M19','M20','M21','M22', 'M23','M24',
-    'M25','M26','M27','M28','M29','M30','M31',
-    'CR','CR0','CR1','CR2','CR3','CR4','CR5','CR6','CR7',
-    'XER','LR','CTR','FPSCR'
-  );
-
-  mot_reg2str : reg2strtable = ('',
-    'r0','r1','r2','r3','r4','r5','r6','r7','r8','r9','r10','r11','r12','r13',
-    'r14','r15','r16','r17','r18','r19','r20','r21','r22','r23','r24','r25',
-    'r26','r27','r28','r29','r30','r31',
-    'F0','F1','F2','F3','F4','F5','F6','F7', 'F8','F9','F10','F11','F12',
-    'F13','F14','F15','F16','F17', 'F18','F19','F20','F21','F22', 'F23','F24',
-    'F25','F26','F27','F28','F29','F30','F31',
-    'M0','M1','M2','M3','M4','M5','M6','M7','M8','M9','M10','M11','M12',
-    'M13','M14','M15','M16','M17','M18','M19','M20','M21','M22', 'M23','M24',
-    'M25','M26','M27','M28','M29','M30','M31',
-    'CR','CR0','CR1','CR2','CR3','CR4','CR5','CR6','CR7',
-    'XER','LR','CTR','FPSCR'
-  );
-
-  { FIX ME !!!!!!!!! }
-  ALL_REGISTERS = [R_0..R_FPSCR];
-
-
-{*****************************************************************************
-                                Conditions
-*****************************************************************************}
-
-type
-{$ifndef tp}
-{$minenumsize 1}
-{$endif tp}
-  TAsmCondFlags = (C_None { unconditional junps },
-    { conditions when not using ctr decrement etc }
-    C_LT,C_LE,C_EQ,C_GE,C_GT,C_NL,C_NE,C_NG,C_SO,C_NS,C_UN,C_NU,
-    { conditions when using ctr decrement etc }
-    C_T,C_F,C_DNZ,C_DNZT,C_DNZF,C_DZ,C_DZT,C_DZF);
-
-{$ifndef tp}
-{$minenumsize default}
-{$endif tp}
-  TAsmCond = packed record
-               case simple: boolean of
-                 false: (BO, BI: byte);
-                 true: (
-                   case cond: TAsmCondFlags of
-                     C_None: ();
-                     { specifies in which part of the cr the bit has to be }
-                     { tested for blt,bgt,beq etc.                         }
-                     C_LT,C_LE,C_EQ,C_GE,C_GT,C_NL,C_NE,C_NG,C_SO,
-                       C_NS,C_UN,C_NU: (cr: R_CR0..R_CR7);
-                     { specifies the bit to test for bt,bf,bdz etc. }
-                     C_T,C_F,C_DNZ,C_DNZT,C_DNZF,C_DZ,C_DZT,C_DZF:
-                       (crbit: byte)
-                   );
-             end;
-
-const
-{  AsmCondFlag2BO: Array[TAsmCondFlags] of Byte =
-    (0,12,4,12,4,12,4,4,4,12,4,12,4,
-    );
-  AsmCondFlag2BI: Array[TAsmCondFlags] of Byte =
-    (0,0,1,2,0,1,0,2,1,3,3,3,3);}
-
-  AsmCondFlag2Str: Array[tasmcondflags] of string[2] = ({cf_none}'',
-     { conditions when not using ctr decrement etc}
-     'lt','le','eq','ge','gt','nl','ne','ng','so','ns','un','nu',
-     't','f','dnz','dzt','dnzf','dz','dzt','dzf');
-
-
-
-const
-  CondAsmOps=3;
-  CondAsmOp:array[0..CondAsmOps-1] of TasmOp=(
-     A_BC, A_TW, A_TWI
-  );
-{*****************************************************************************
-                                   Flags
-*****************************************************************************}
-
-type
-  TResFlags = (F_LT,F_GT,F_EQ,F_SO,F_FX,F_FEX,F_VX,F_OX);
-(*
-const
-  { arrays for boolean location conversions }
-  flag_2_cond : array[TResFlags] of TAsmCond =
-     (C_E,C_NE,C_G,C_L,C_GE,C_LE,C_C,C_NC,C_A,C_AE,C_B,C_BE);
-*)
-
-{*****************************************************************************
-                                Reference
-*****************************************************************************}
-
-type
-  trefoptions=(ref_none,ref_parafixup,ref_localfixup);
-
-  { since we have only 16 offsets, we need to be able to specify the high }
-  { and low 16 bits of the address of a symbol                            }
-  trefsymaddr = (refs_full,refs_ha,refs_l);
-
-  { immediate/reference record }
-  preference = ^treference;
-  treference = packed record
-     is_immediate: boolean; { is this used as reference or immediate }
-     base, index : tregister;
-     offset      : longint;
-     symbol      : tasmsymbol;
-     symaddr     : trefsymaddr;
-     offsetfixup : longint;
-     options     : trefoptions;
-     alignment   : byte;
-  end;
-
-const symaddr2str: array[trefsymaddr] of string[3] = ('','@ha','@l');
-
-
-{*****************************************************************************
-                                Operand
-*****************************************************************************}
-
-type
-  toptype=(top_none,top_reg,top_ref,top_const,top_symbol,top_bool);
-
-  toper=record
-    ot  : longint;
-    case typ : toptype of
-     top_none   : ();
-     top_reg    : (reg:tregister);
-     top_ref    : (ref:preference);
-     top_const  : (val:aword);
-     top_symbol : (sym:tasmsymbol;symofs:longint);
-     top_bool  :  (b: boolean);
-  end;
-
-
-{*****************************************************************************
-                               Generic Location
-*****************************************************************************}
-
-type
-  TLoc=(
-    LOC_INVALID,     { added for tracking problems}
-    LOC_REGISTER,    { in a processor register }
-    LOC_CREGISTER,   { Constant register which shouldn't be modified }
-    LOC_FPU,         { FPU register, called LOC_FPU for historic reasons }
-    LOC_CFPUREGISTER,{ Constant FPU register which shouldn't be modified }
-    LOC_MMREGISTER,  { multimedia register }
-    LOC_CMMREGISTER, { Constant multimedia reg which shouldn't be modified }
-    LOC_MEM,         { in memory }
-    LOC_REFERENCE,   { like LOC_MEM, but lvalue }
-    LOC_JUMP,        { boolean results only, jump to false or true label }
-    LOC_FLAGS        { boolean results only, flags are set }
-  );
-
-  plocation = ^tlocation;
-  tlocation = packed record
-     case loc : tloc of
-        LOC_MEM,LOC_REFERENCE : (reference : treference);
-        LOC_FPU, LOC_CFPUREGISTER, LOC_MMREGISTER, LOC_CMMREGISTER,
-          LOC_REGISTER,LOC_CREGISTER : (
-            case longint of
-              1 : (registerlow,registerhigh : tregister);
-              { overlay a registerlow }
-              2 : (register : tregister);
-            );
-
-        LOC_JUMP : ();
-        LOC_FLAGS : (resflags : tresflags);
-        LOC_INVALID : ();
-
-        { segment in reference at the same place as in loc_register }
-  end;
-
-
-{*****************************************************************************
-                                 Constants
-*****************************************************************************}
-
-const
-  availabletempregsint = [R_11..R_30];
-  availabletempregsfpu = [R_F14..R_F31];
-  availabletempregsmm  = [R_M0..R_M31];
-
-  lvaluelocations = [LOC_REFERENCE, LOC_CREGISTER, LOC_CFPUREGISTER,
-                     LOC_CMMREGISTER];
-
-  c_countusableregsint = 21;
-  c_countusableregsfpu = 32;
-  c_countusableregsmm  = 32;
-
-  max_operands = 5;
-
-  maxvarregs = 18;
-
-  varregs : Array [1..maxvarregs] of Tregister =
-            (R_13,R_14,R_15,R_16,R_17,R_18,R_19,R_20,R_21,R_22,R_23,R_24,R_25,
-             R_26,R_27,R_28,R_29,R_30);
-
-  max_param_regs_int = 8;
-  param_regs_int: Array[1..max_param_regs_int] of tregister =
-    (R_3,R_4,R_5,R_6,R_7,R_8,R_9,R_10);
-
-  max_param_regs_fpu = 13;
-  param_regs_fpu: Array[1..max_param_regs_fpu] of tregister =
-    (R_F1,R_F2,R_F3,R_F4,R_F5,R_F6,R_F7,R_F8,R_F9,R_F10,R_F11,R_F12,R_F13);
-
-  general_registers = [R_0..R_31];
-
-  intregs = [R_0..R_31];
-  fpuregs = [R_F0..R_F31];
-  mmregs = [R_M0..R_M31];
-
-  cpuflags = [];
-
-  registers_saved_on_cdecl = [R_13..R_29];
-
-  { generic register names }
-  stack_pointer = R_1;
-  R_RTOC        = R_2;
-  frame_pointer = stack_pointer;
-  self_pointer  = R_9;
-  accumulator   = R_3;
-  vmt_offset_reg = R_0;
-  max_scratch_regs = 3;
-  scratch_regs: Array[1..max_scratch_regs] of TRegister = (R_11,R_12,R_30);
-
-  { FIX ME !!!!!!!!! }
-  maxfpuvarregs = 4;
-
-  maxintregs = maxvarregs;
-  maxfpuregs = maxfpuvarregs;
-
-{ low and high of the available maximum width integer general purpose }
-{ registers                                                           }
-  LoGPReg = R_0;
-  HiGPReg = R_31;
-
-{ low and high of every possible width general purpose register (same as }
-{ above on most architctures apart from the 80x86)                       }
-  LoReg = R_0;
-  HiReg = R_31;
-
-(*  cpuflags : set of tcpuflags = []; *)
-
-  { sizes }
-  pointersize   = 4;
-  extended_size = 8;
-
-  LinkageAreaSize = 24;
- { offset in the linkage area for the saved stack pointer }
-  LA_SP = 0;
- { offset in the linkage area for the saved conditional register}
-  LA_CR = 4;
- { offset in the linkage area for the saved link register}
-  LA_LR = 8;
- { offset in the linkage area for the saved RTOC register}
-  LA_RTOC = 20;
-
-{*****************************************************************************
-                                  Helpers
-*****************************************************************************}
-
-    { resets all values of ref to defaults }
-    procedure reset_reference(var ref : treference);
-    { set mostly used values of a new reference }
-    function new_reference(base : tregister;offset : longint) : preference;
-
-    function newreference(const r : treference) : preference;
-    procedure disposereference(var r : preference);
-
-    function reg2str(r : tregister) : string;
-
-    function is_calljmp(o:tasmop):boolean;
-
-    procedure inverse_cond(c: TAsmCond;var r : TAsmCond);
-    procedure create_cond_imm(BO,BI:byte;var r : TAsmCond);
-    procedure create_cond_norm(cond: TAsmCondFlags; cr: byte;var r : TasmCond);
-
-    procedure clear_location(var loc : tlocation);
-    procedure set_location(var destloc,sourceloc : tlocation);
-    procedure swap_location(var destloc,sourceloc : tlocation);
-
-{*****************************************************************************
-                                  Init/Done
-*****************************************************************************}
-
-  procedure InitCpu;
-  procedure DoneCpu;
-
-
-implementation
-
-{$ifdef heaptrc}
-  uses
-      ppheap;
-{$endif heaptrc}
-
-{*****************************************************************************
-                                  Helpers
-*****************************************************************************}
-
-    function reg2str(r : tregister) : string;
-      begin
-         reg2str:=mot_reg2str[r];
-      end;
-
-
-    function is_calljmp(o:tasmop):boolean;
-      begin
-       is_calljmp:=false;
-        case o of
-          A_B,A_BA,A_BL,A_BLA,A_BC,A_BCA,A_BCL,A_BCLA,A_BCCTR,A_BCCTRL,A_BCLR,
-            A_BCLRL,A_TW,A_TWI: is_calljmp:=true;
-        end;
-      end;
-
-    procedure disposereference(var r : preference);
-      begin
-         dispose(r);
-         r:=nil;
-      end;
-
-
-    function newreference(const r : treference) : preference;
-      var
-         p : preference;
-      begin
-         new(p);
-         p^:=r;
-         newreference:=p;
-      end;
-
-    procedure reset_reference(var ref : treference);
-      begin
-        FillChar(ref,sizeof(treference),0)
-      end;
-
-    function new_reference(base : tregister;offset : longint) : preference;
-    var
-      r : preference;
-    begin
-      new(r);
-      FillChar(r^,sizeof(treference),0);
-      r^.base:=base;
-      r^.offset:=offset;
-      new_reference:=r;
-    end;
-
-
-    procedure inverse_cond(c: TAsmCond;var r : TAsmCond);
-    const
-      inv_condflags:array[TAsmCondFlags] of TAsmCondFlags=(C_None,
-        C_GE,C_GT,C_NE,C_LT,C_LE,C_LT,C_EQ,C_GT,C_NS,C_SO,C_NU,C_UN,
-        C_F,C_T,C_DNZ,C_DNZF,C_DNZT,C_DZ,C_DZF,C_DZT);
-    begin
-      c.cond := inv_condflags[c.cond];
-      r := c;
-    end;
-
-    procedure create_cond_imm(BO,BI:byte;var r : TAsmCond);
-    var c: tasmcond;
-    begin
-      c.simple := false;
-      c.bo := bo;
-      c.bi := bi;
-      r := c
-    end;
-
-    procedure create_cond_norm(cond: TAsmCondFlags; cr: byte;var r : TasmCond);
-    const cr2reg: array[0..7] of tregister =
-            (R_CR0,R_CR1,R_CR2,R_CR3,R_CR4,R_CR5,R_CR6,R_CR7);
-    var c: tasmcond;
-    begin
-      c.simple := true;
-      c.cond := cond;
-      case cond of
-        C_NONE:;
-        C_T..C_DZF: c.crbit := cr
-        else c.cr := cr2reg[cr];
-      end;
-      r := c;
-    end;
-
-    procedure clear_location(var loc : tlocation);
-
-      begin
-        loc.loc:=LOC_INVALID;
-      end;
-
-    {This is needed if you want to be able to delete the string with the nodes !!}
-    procedure set_location(var destloc,sourceloc : tlocation);
-
-      begin
-        destloc:= sourceloc;
-      end;
-
-    procedure swap_location(var destloc,sourceloc : tlocation);
-
-      var
-         swapl : tlocation;
-
-      begin
-         swapl := destloc;
-         destloc := sourceloc;
-         sourceloc := swapl;
-      end;
-
-{*****************************************************************************
-                                  Init/Done
-*****************************************************************************}
-
-  procedure InitCpu;
-    begin
-    end;
-
-  procedure DoneCpu;
-    begin
-    end;
-
-end.
-{
-  $Log$
-  Revision 1.2  2001-08-26 13:29:34  florian
-    * some cg reorganisation
-    * some PPC updates
-
-  Revision 1.1  2000/07/13 06:30:12  michael
-    + Initial import
-
-  Revision 1.15  2000/05/01 11:04:49  jonas
-    * changed NOT to A_NOP
-
-  Revision 1.14  2000/04/29 09:01:06  jonas
-    * nmem compiles again (at least for powerpc)
-
-  Revision 1.13  2000/03/26 16:38:06  jonas
-    * frame_pointer = stackpointer instead of R_NO
-
-  Revision 1.12  2000/01/07 01:14:58  peter
-    * updated copyright to 2000
-
-  Revision 1.11  1999/12/24 22:48:10  jonas
-    * compiles again
-
-  Revision 1.10  1999/11/09 22:57:09  peter
-    * compiles again both i386,alpha both with optimizer
-
-  Revision 1.9  1999/10/20 12:21:34  jonas
-    * changed scratch_registers to (R_11,_R12,R_30) because R_0 is a special
-      case and R_31 is used as some kind of frame pointer under LinuxPPC
-
-  Revision 1.8  1999/10/14 14:57:55  florian
-    - removed the hcodegen use in the new cg, use cgbase instead
-
-  Revision 1.7  1999/09/15 20:35:47  florian
-    * small fix to operator overloading when in MMX mode
-    + the compiler uses now fldz and fld1 if possible
-    + some fixes to floating point registers
-    + some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
-    * .... ???
-
-  Revision 1.6  1999/09/03 13:11:59  jonas
-    * several changes to the way conditional branches are handled\n  * some typos fixed
-
-  Revision 1.5  1999/08/23 23:27:54  pierre
-    + dummy InitCpu/DoneCpu
-
-  Revision 1.4  1999/08/06 16:41:12  jonas
-    * PowerPC compiles again, several routines implemented in cgcpu.pas
-    * added constant to cpubase of alpha and powerpc for maximum
-      number of operands
-
-  Revision 1.3  1999/08/05 14:58:18  florian
-    * some fixes for the floating point registers
-    * more things for the new code generator
-
-  Revision 1.2  1999/08/04 12:59:25  jonas
-    * all tokes now start with an underscore
-    * PowerPC compiles!!
-
-  Revision 1.1  1999/08/03 23:37:53  jonas
-    + initial implementation for PowerPC based on the Alpha stuff
-
-}

compiler/new/powerpc/cpuinfo.pas

@@ -1,52 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 by the Free Pascal development team
-
-    Basic Processor information for the 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.
-
- **********************************************************************}
-
-Unit CPUInfo;
-
-Interface
-
-Type
-   { Architecture word - Native unsigned type }
-   AWord = Dword;
-
-Type
-   { the ordinal type used when evaluating constant integer expressions }
-   TConstExprInt = int64;
-   { ... the same unsigned }
-   TConstExprUInt = {$ifdef fpc}qword{$else}int64{$endif};
-
-   { this must be an ordinal type with the same size as a pointer }
-   { to allow some dirty type casts for example when using        }
-   { tconstsym.value                                              }
-   { Note: must be unsigned!! Otherwise, ugly code like           }
-   { pointer(-1) will result in a pointer with the value          }
-   { $fffffffffffffff on a 32bit machine if the compiler uses     }
-   { int64 constants internally (JM)                              }
-   TPointerOrd = DWord;
-
-Const
-   { Size of native extended type }
-   extended_size = 8;
-
-Implementation
-
-end.
-{
-  $Log$
-  Revision 1.2  2001-08-26 13:29:34  florian
-    * some cg reorganisation
-    * some PPC updates
-
-}

compiler/new/powerpc/tgcpu.pas

@@ -1,179 +0,0 @@
-{
-    $Id$
-    Copyright (C) 1998-2000 by Florian Klaempfl
-
-    This unit handles the temporary variables stuff for 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 tgcpu;
-
-  interface
-
-    uses
-       globals,
-       cgbase,verbose,aasm,
-       node,
-       cpuinfo,cpubase,cpuasm;
-
-    const
-       { this value is used in tsaved, if the register isn't saved }
-       reg_not_saved = $7fffffff;
-
-    type
-       tpushed = array[R_NO..R_NO] of boolean;
-       tsaved = array[R_NO..R_NO] of longint;
-
-    var
-       { tries to hold the amount of times which the current tree is processed  }
-       t_times : longint;
-
-    function getregisterint : tregister;
-    procedure ungetregisterint(r : tregister);
-    { tries to allocate the passed register, if possible }
-    function getexplicitregisterint(r : tregister) : tregister;
-
-    procedure ungetregister(r : tregister);
-
-    procedure cleartempgen;
-    procedure del_reference(const ref : treference);
-    procedure del_locref(const location : tlocation);
-    procedure del_location(const l : tlocation);
-
-    { pushs and restores registers }
-    procedure pushusedregisters(var pushed : tpushed;b : byte);
-    procedure popusedregisters(const pushed : tpushed);
-
-    { saves and restores used registers to temp. values }
-    procedure saveusedregisters(var saved : tsaved;b : byte);
-    procedure restoreusedregisters(const saved : tsaved);
-
-    { increments the push count of all registers in b}
-    procedure incrementregisterpushed(regs : tregisterset);
-
-    procedure clearregistercount;
-    procedure resetusableregisters;
-
-    type
-       regvar_longintarray = array[0..32+32-1] of longint;
-       regvar_booleanarray = array[0..32+32-1] of boolean;
-       regvar_ptreearray = array[0..32+32-1] of tnode;
-
-    var
-       unused,usableregs : tregisterset;
-
-       { uses only 1 byte while a set uses in FPC 32 bytes }
-       usedinproc : byte;
-
-       { count, how much a register must be pushed if it is used as register }
-       { variable                                                           }
-       reg_pushes : regvar_longintarray;
-       is_reg_var : regvar_booleanarray;
-
-
-implementation
-
-    uses
-      globtype,temp_gen;
-
-
-    function getregisterint : tregister;
-      begin
-      end;
-
-    procedure ungetregisterint(r : tregister);
-      begin
-      end;
-
-    { tries to allocate the passed register, if possible }
-    function getexplicitregisterint(r : tregister) : tregister;
-      begin
-      end;
-
-    procedure ungetregister(r : tregister);
-      begin
-      end;
-
-    procedure cleartempgen;
-      begin
-      end;
-
-    procedure del_reference(const ref : treference);
-      begin
-      end;
-
-    procedure del_locref(const location : tlocation);
-      begin
-      end;
-
-    procedure del_location(const l : tlocation);
-      begin
-      end;
-
-    { pushs and restores registers }
-    procedure pushusedregisters(var pushed : tpushed;b : byte);
-      begin
-      end;
-
-    procedure popusedregisters(const pushed : tpushed);
-      begin
-      end;
-
-    { saves and restores used registers to temp. values }
-    procedure saveusedregisters(var saved : tsaved;b : byte);
-      begin
-      end;
-
-    procedure restoreusedregisters(const saved : tsaved);
-      begin
-      end;
-
-    { increments the push count of all registers in b}
-    procedure incrementregisterpushed(regs : tregisterset);
-      begin
-      end;
-
-    procedure clearregistercount;
-      begin
-      end;
-
-    procedure resetusableregisters;
-      begin
-      end;
-
-begin
-   resetusableregisters;
-end.
-{
-  $Log$
-  Revision 1.2  2001-08-26 13:23:23  florian
-    * some cg reorganisation
-    * some PPC updates
-
-  Revision 1.1  2000/07/13 06:30:13  michael
-    + Initial import
-
-  Revision 1.3  2000/01/07 01:14:58  peter
-    * updated copyright to 2000
-
-  Revision 1.2  1999/08/04 12:59:26  jonas
-    * all tokes now start with an underscore
-    * PowerPC compiles!!
-
-  Revision 1.1  1999/08/03 23:37:53  jonas
-    + initial implementation for PowerPC based on the Alpha stuff
-}

compiler/new/tgeni386.pas

@@ -1,73 +0,0 @@
-{
-    $Id$
-    Copyright (C) 1998-2000 by Florian Klaempfl
-
-    Dummy
-
-    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 tgeni386;
-
-  interface
-
-    procedure cleartempgen;
-    procedure resettempgen;
-    procedure resetusableregisters;
-
-  implementation
-
-    uses
-       tgcpu;
-
-    procedure cleartempgen;
-
-      begin
-         tg.cleartempgen;
-      end;
-
-    procedure resettempgen;
-
-      begin
-         tg.resettempgen;
-      end;
-
-    procedure resetusableregisters;
-
-      begin
-         tg.resetusableregisters;
-      end;
-end.
-{
-  $Log$
-  Revision 1.1  2000-07-13 06:30:09  michael
-  + Initial import
-
-  Revision 1.4  2000/02/20 20:49:46  florian
-    * newcg is compiling
-    * fixed the dup id problem reported by Paul Y.
-
-  Revision 1.3  2000/01/07 01:14:54  peter
-    * updated copyright to 2000
-
-  Revision 1.2  1999/08/02 21:29:09  florian
-    * the main branch psub.pas is now used for
-      newcg compiler
-
-  Revision 1.1  1999/08/02 17:15:05  florian
-    * dummy implementation
-
-}

compiler/nflw.pas

@@ -166,13 +166,8 @@ implementation
       globtype,systems,
       cutils,verbose,globals,
       symconst,symtable,types,htypechk,pass_1,
-      ncon,nmem,nld,ncnv,nbas,tgcpu,hcodegen
-{$ifdef newcg}
-      ,tgobj
-      ,cgbase
-{$else newcg}
-      ,temp_gen
-{$endif newcg}
+      ncon,nmem,nld,ncnv,nbas,tgcpu,
+      cgbase,temp_gen
       ;
 
     function genloopnode(t : tnodetype;l,r,n1 : tnode;back : boolean) : tnode;
@@ -1171,7 +1166,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.21  2001-08-06 21:40:47  peter
+  Revision 1.22  2001-08-26 13:36:40  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.21  2001/08/06 21:40:47  peter
     * funcret moved from tprocinfo to tprocdef
 
   Revision 1.20  2001/04/26 21:56:08  peter

compiler/ninl.pas

@@ -61,10 +61,7 @@ implementation
       symbase,symconst,symtype,symdef,symsym,symtable,types,
       pass_1,
       ncal,ncon,ncnv,nadd,nld,nbas,nflw,nmem,
-      cpubase,hcodegen,tgcpu
-{$ifdef newcg}
-      ,cgbase
-{$endif newcg}
+      cpubase,tgcpu,cgbase
       ;
 
    function geninlinenode(number : byte;is_const:boolean;l : tnode) : tinlinenode;
@@ -114,7 +111,7 @@ implementation
 
       begin
         result := cerrornode.create;
-        
+
         { make sure we got at least two parameters (if we got only one, }
         { this parameter may not be encapsulated in a callparan)        }
         if not assigned(left) or
@@ -131,7 +128,7 @@ implementation
         while assigned(source.right) do
           source := tcallparanode(source.right);
         is_real := source.resulttype.def.deftype = floatdef;
-        
+
         if not assigned(dest) or
            (dest.left.resulttype.def.deftype<>stringdef) or
            not(is_real or
@@ -149,7 +146,7 @@ implementation
         if (cpf_is_colon_para in tcallparanode(dest.right).callparaflags) then
           begin
             lenpara := tcallparanode(dest.right);
-            
+
             { we can let the callnode do the type checking of these parameters too, }
             { but then the error messages aren't as nice                            }
             if not is_integer(lenpara.resulttype.def) then
@@ -203,7 +200,7 @@ implementation
           if not assigned(lenpara) then
             newparas.right := ccallparanode.create(cordconstnode.create(-1,s32bittype),
               newparas.right);
-        
+
         { remove the parameters from the original node so they won't get disposed, }
         { since they're reused                                                     }
         left := nil;
@@ -233,8 +230,8 @@ implementation
         result.free;
         result := newnode;
       end;
-      
-      
+
+
     function tinlinenode.handle_reset_rewrite_typed: tnode;
       begin
         { since this is a "in_xxxx_typedfile" node, we can be sure we have  }
@@ -263,7 +260,7 @@ implementation
       const
         procnames: array[boolean,boolean] of string[11] =
           (('write_text_','read_text_'),('typed_write','typed_read'));
-      
+
       var
         filepara,
         lenpara,
@@ -313,7 +310,7 @@ implementation
                     CGMessagePos(fileinfo,type_e_no_read_write_for_untyped_file);
                     exit;
                   end
-                else 
+                else
                   begin
                     if (tfiledef(filepara.resulttype.def).filetyp=ft_typed) then
                       begin
@@ -792,8 +789,8 @@ implementation
               result := newblock
             end;
       end;
-      
-      
+
+
     function tinlinenode.handle_val: tnode;
       var
         procname,
@@ -2712,7 +2709,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.51  2001-08-24 13:47:27  jonas
+  Revision 1.52  2001-08-26 13:36:40  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.51  2001/08/24 13:47:27  jonas
     * moved "reverseparameters" from ninl.pas to ncal.pas
     + support for non-persistent temps in ttempcreatenode.create, for use
       with typeconversion nodes

compiler/nld.pas

@@ -102,11 +102,7 @@ implementation
       cutils,verbose,globtype,globals,systems,
       symconst,symdef,symtable,types,
       htypechk,pass_1,
-      ncnv,nmem,cpubase,tgcpu,hcodegen
-{$ifdef newcg}
-      ,cgbase
-      ,tgobj
-{$endif newcg}
+      ncnv,nmem,cpubase,tgcpu,cgbase
       ;
 
 
@@ -785,7 +781,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.22  2001-08-12 22:11:52  peter
+  Revision 1.23  2001-08-26 13:36:41  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.22  2001/08/12 22:11:52  peter
     * errordef.typesym is not updated anymore
 
   Revision 1.21  2001/08/06 21:40:47  peter

compiler/nmat.pas

@@ -69,10 +69,7 @@ implementation
 {$endif}
       symconst,symtype,symtable,symdef,types,
       htypechk,pass_1,cpubase,cpuinfo,
-{$ifdef newcg}
       cgbase,
-{$endif newcg}
-      hcodegen,
       ncon,ncnv,ncal;
 
 {****************************************************************************
@@ -375,7 +372,9 @@ implementation
            end;
       end;
 
-
+    { generic code     }
+    { overridden by:   }
+    {   i386           }
     function tunaryminusnode.pass_1 : tnode;
       begin
          result:=nil;
@@ -391,7 +390,10 @@ implementation
 
          if (left.resulttype.def.deftype=floatdef) then
            begin
-             location.loc:=LOC_FPU;
+              if (left.location.loc<>LOC_REGISTER) and
+                 (registers32<1) then
+                registers32:=1;
+              location.loc:=LOC_REGISTER;
            end
 {$ifdef SUPPORT_MMX}
          else if (cs_mmx in aktlocalswitches) and
@@ -588,7 +590,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.20  2001-04-13 01:22:10  peter
+  Revision 1.21  2001-08-26 13:36:41  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.20  2001/04/13 01:22:10  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/nmem.pas

@@ -134,12 +134,7 @@ implementation
       globtype,systems,
       cutils,verbose,globals,
       symconst,symbase,types,
-      htypechk,pass_1,ncal,nld,ncon,ncnv
-{$ifdef newcg}
-      ,cgbase
-{$else newcg}
-      ,hcodegen
-{$endif newcg}
+      htypechk,pass_1,ncal,nld,ncon,ncnv,cgbase
       ;
 
 {*****************************************************************************
@@ -975,7 +970,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.18  2001-04-13 22:15:21  peter
+  Revision 1.19  2001-08-26 13:36:42  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.18  2001/04/13 22:15:21  peter
     * removed wrongly placed set_varstate in subscriptnode
 
   Revision 1.17  2001/04/13 01:22:10  peter

compiler/nopt.pas

@@ -85,7 +85,7 @@ var
 implementation
 
 uses cutils, htypechk, types, globtype, globals, cpubase, ncnv, ncon,
-     verbose, symdef, hcodegen;
+     verbose, symdef, cgbase;
 
 
 {*****************************************************************************
@@ -278,7 +278,11 @@ end.
 
 {
   $Log$
-  Revision 1.3  2001-04-13 01:22:10  peter
+  Revision 1.4  2001-08-26 13:36:43  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.3  2001/04/13 01:22:10  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/nset.pas

@@ -109,11 +109,7 @@ implementation
       verbose,globals,
       symconst,symdef,symsym,types,
       htypechk,pass_1,
-      ncnv,ncon,cpubase,nld,hcodegen,tgcpu
-{$ifdef newcg}
-      ,cgbase
-{$endif newcg}
-      ;
+      ncnv,ncon,cpubase,nld,tgcpu,cgbase;
 
     function gencasenode(l,r : tnode;nodes : pcaserecord) : tnode;
 
@@ -588,7 +584,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.13  2001-04-13 01:22:10  peter
+  Revision 1.14  2001-08-26 13:36:43  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.13  2001/04/13 01:22:10  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/parser.pas

@@ -39,7 +39,7 @@ implementation
       cutils,cclasses,
       globtype,version,tokens,systems,globals,verbose,
       symbase,symtable,symsym,fmodule,fppu,aasm,
-      hcodegen,
+      cgbase,
       script,gendef,
 {$ifdef BrowserLog}
       browlog,
@@ -617,7 +617,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.21  2001-07-30 20:59:27  peter
+  Revision 1.22  2001-08-26 13:36:43  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.21  2001/07/30 20:59:27  peter
     * m68k updates from v10 merged
 
   Revision 1.20  2001/07/01 20:16:16  peter

compiler/pass_1.pas

@@ -45,15 +45,12 @@ implementation
     uses
       globtype,systems,
       cutils,globals,
-      hcodegen,symdef,
+      cgbase,symdef,
 {$ifdef extdebug}
       verbose,
       htypechk,
 {$endif extdebug}
       tgcpu
-{$ifdef newcg}
-      ,cgbase
-{$endif}
       ;
 
 {*****************************************************************************
@@ -173,7 +170,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.15  2001-07-06 15:29:39  peter
+  Revision 1.16  2001-08-26 13:36:44  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.15  2001/07/06 15:29:39  peter
     * fixed EXTDEBUG
 
   Revision 1.14  2001/04/15 09:48:30  peter

compiler/pass_2.pas

@@ -53,7 +53,7 @@ implementation
      globtype,systems,verbose,
      cclasses,globals,
      symconst,symbase,symtype,symsym,aasm,
-     pass_1,hcodegen,temp_gen,regvars,nflw,tgcpu;
+     pass_1,cgbase,temp_gen,regvars,nflw,tgcpu;
 
 {*****************************************************************************
                               SecondPass
@@ -306,7 +306,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.17  2001-08-06 21:40:47  peter
+  Revision 1.18  2001-08-26 13:36:44  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.17  2001/08/06 21:40:47  peter
     * funcret moved from tprocinfo to tprocdef
 
   Revision 1.16  2001/05/09 19:57:07  peter

compiler/pdecobj.pas

@@ -38,7 +38,7 @@ implementation
       cutils,cclasses,
       globals,verbose,systems,tokens,
       aasm,symconst,symbase,symsym,symtable,types,
-      hcodegen,
+      cgbase,
       node,nld,ncon,ncnv,nobj,pass_1,
       scanner,
       pbase,pexpr,pdecsub,pdecvar,ptype;
@@ -1045,7 +1045,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.27  2001-08-22 21:16:20  florian
+  Revision 1.28  2001-08-26 13:36:44  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.27  2001/08/22 21:16:20  florian
     * some interfaces related problems regarding
       mapping of interface implementions fixed
 

compiler/pdecsub.pas

@@ -78,11 +78,7 @@ implementation
        { linking }
        import,gendef,
        { codegen }
-{$ifdef newcg}
        cgbase
-{$else}
-       hcodegen
-{$endif}
        ;
 
 
@@ -1926,7 +1922,11 @@ const
 end.
 {
   $Log$
-  Revision 1.35  2001-08-23 14:28:36  jonas
+  Revision 1.36  2001-08-26 13:36:45  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.35  2001/08/23 14:28:36  jonas
     + tempcreate/ref/delete nodes (allows the use of temps in the
       resulttype and first pass)
     * made handling of read(ln)/write(ln) processor independent

compiler/pexpr.pas

@@ -70,11 +70,7 @@ implementation
        scanner,
        pbase,
        { codegen }
-{$ifdef newcg}
        cgbase
-{$else}
-       hcodegen
-{$endif}
        ;
 
     { sub_expr(opmultiply) is need to get -1 ** 4 to be
@@ -2324,7 +2320,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.40  2001-08-22 21:16:21  florian
+  Revision 1.41  2001-08-26 13:36:45  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.40  2001/08/22 21:16:21  florian
     * some interfaces related problems regarding
       mapping of interface implementions fixed
 

compiler/pmodules.pas

@@ -39,14 +39,8 @@ implementation
        cutils,comphook,
        globals,verbose,fmodule,finput,fppu,
        symconst,symbase,symppu,symdef,symsym,symtable,aasm,
-{$ifdef newcg}
        cgbase,
-{$else newcg}
-       hcodegen,
-{$ifdef i386}
-       cgai386,
-{$endif i386}
-{$endif newcg}
+       cga,
        link,assemble,import,export,gendef,ppu,comprsrc,
        cresstr,cpubase,cpuasm,
 {$ifdef GDB}
@@ -1335,7 +1329,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.44  2001-08-19 11:22:23  peter
+  Revision 1.45  2001-08-26 13:36:46  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.44  2001/08/19 11:22:23  peter
     * palmos support from v10 merged
 
   Revision 1.43  2001/08/12 19:59:49  peter

compiler/pp.pas

@@ -25,7 +25,6 @@ program pp;
 {
   possible compiler switches (* marks a currently required switch):
   -----------------------------------------------------------------
-  TP                  to compile the compiler with Turbo or Borland Pascal
   GDB*                support of the GNU Debugger
   I386                generate a compiler for the Intel i386+
   M68K                generate a compiler for the M68000
@@ -47,12 +46,6 @@ program pp;
 
   Required switches for a i386 compiler be compiled by Free Pascal Compiler:
   GDB;I386
-
-  Required switches for a i386 compiler be compiled by Turbo Pascal:
-  GDB;I386;TP
-
-  Required switches for a 68000 compiler be compiled by Turbo Pascal:
-  GDB;M68k;TP
 }
 
 {$i defines.inc}
@@ -62,8 +55,7 @@ program pp;
       { people can try to compile without GDB }
       { $error The compiler switch GDB must be defined}
    {$endif GDB}
-   { but I386 or M68K must be defined }
-   { and only one of the two }
+   { exactly one target CPU must be defined }
    {$ifdef I386}
      {$ifdef CPUDEFINED}
         {$fatal ONLY one of the switches for the CPU type must be defined}
@@ -82,6 +74,12 @@ program pp;
      {$endif CPUDEFINED}
      {$define CPUDEFINED}
    {$endif iA64}
+   {$ifdef POWERPC}
+     {$ifdef CPUDEFINED}
+        {$fatal ONLY one of the switches for the CPU type must be defined}
+     {$endif CPUDEFINED}
+     {$define CPUDEFINED}
+   {$endif POWERPC}
    {$ifndef CPUDEFINED}
      {$fatal A CPU type switch must be defined}
    {$endif CPUDEFINED}
@@ -158,7 +156,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.7  2001-02-26 19:44:53  peter
+  Revision 1.8  2001-08-26 13:36:46  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.7  2001/02/26 19:44:53  peter
     * merged generic m68k updates from fixes branch
 
   Revision 1.6  2000/11/29 00:30:37  florian
@@ -176,5 +178,4 @@ end.
 
   Revision 1.2  2000/07/13 11:32:45  michael
   + removed logs
-
 }

compiler/pstatmnt.pas

@@ -54,7 +54,7 @@ implementation
        scanner,
        pbase,pexpr,
        { codegen }
-       tgcpu,hcodegen
+       tgcpu,cgbase
 {$ifdef i386}
   {$ifndef NoRa386Int}
        ,ra386int
@@ -801,6 +801,10 @@ implementation
                   else if pattern='A1' then
                     usedinproc:=usedinproc + [R_A1]
 {$endif m68k}
+{$ifdef powerpc}
+                  if pattern<>'' then
+                    internalerror(200108251)
+{$endif powerpc}
                   else consume(_RECKKLAMMER);
                   consume(_CSTRING);
                   if not try_to_consume(_COMMA) then
@@ -811,7 +815,11 @@ implementation
 {$ifdef i386}
          else usedinproc:=$ff;
 {$else}
+{$ifdef powerpc}
+         else usedinproc := 0;
+{$else powerpc}
          else usedinproc := ALL_REGISTERS;
+{$endif powerpc}
 {$endif i386}
 {$endif newcg}
 
@@ -1184,7 +1192,11 @@ implementation
 {$ifdef i386}
                    usedinproc:=usedinproc or ($80 shr byte(R_EAX))
 {$else}
+{$ifdef POWERPC}
+                   usedinproc:=0;
+{$else POWERPC}
                    usedinproc:=usedinproc + [accumulator];
+{$endif POWERPC}
 {$endif i386}
 {$endif newcg}
                 end
@@ -1225,7 +1237,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.33  2001-08-23 14:28:36  jonas
+  Revision 1.34  2001-08-26 13:36:46  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.33  2001/08/23 14:28:36  jonas
     + tempcreate/ref/delete nodes (allows the use of temps in the
       resulttype and first pass)
     * made handling of read(ln)/write(ln) processor independent

compiler/psub.pas

@@ -23,6 +23,9 @@
 unit psub;
 
 {$i defines.inc}
+{$ifdef powerpc}
+  {$define newcg}
+{$endif powerpc}
 
 interface
 
@@ -59,22 +62,19 @@ implementation
        scanner,
        pbase,pstatmnt,pdecl,pdecsub,pexports,
        { codegen }
-       tgcpu,hcodegen
-{$ifdef newcg}
-       ,cgbase
-       ,cgobj
+       tgcpu,cgbase,
+       temp_gen,
+       cga
        {$ifndef NOOPT}
-        ,aopt
-       {$endif}
-{$else}
-       ,temp_gen
-       {$ifdef i386}
-         ,cgai386
-         {$ifndef NOOPT}
+         {$ifdef i386}
            ,aopt386
-         {$endif}
+         {$else i386}
+           ,aoptcpu
+         {$endif i386}
        {$endif}
-{$endif}
+{$ifdef newcg}
+       ,cgobj
+{$endif newcg}
        ;
 
 
@@ -296,7 +296,11 @@ implementation
          cleartempgen;
 
 {$ifdef newcg}
+{$ifdef POWERPC}
+         tgcpu.usedinproc:=0;
+{$else POWERPC}
          tg.usedinproc:=[];
+{$endif POWERPC}
 {$else newcg}
 {$ifdef i386}
         { no registers are used }
@@ -329,7 +333,7 @@ implementation
          { but only if the are no local variables           }
          { already done in assembler_block }
 {$ifdef newcg}
-         tg.setfirsttemp(procinfo^.firsttemp_offset);
+         setfirsttemp(procinfo^.firsttemp_offset);
 {$else newcg}
          setfirsttemp(procinfo^.firsttemp_offset);
 {$endif newcg}
@@ -352,7 +356,7 @@ implementation
                 generatecode(code);
                 aktprocsym.definition.code:=code;
 {$ifdef newcg}
-                stackframe:=tg.gettempsize;
+                stackframe:=gettempsize;
 {$else newcg}
                 stackframe:=gettempsize;
 {$endif newcg}
@@ -837,7 +841,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.35  2001-08-06 21:40:47  peter
+  Revision 1.36  2001-08-26 13:36:46  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.35  2001/08/06 21:40:47  peter
     * funcret moved from tprocinfo to tprocdef
 
   Revision 1.34  2001/06/04 11:53:13  peter

compiler/ptconst.pas

@@ -50,10 +50,7 @@ implementation
        { parser specific stuff }
        pbase,pexpr,
        { codegen }
-       hcodegen
-{$ifdef newcg}
-       ,cgbase
-{$endif}
+       cgbase
        ;
 
 {$ifdef fpc}
@@ -919,7 +916,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.30  2001-08-01 21:46:41  peter
+  Revision 1.31  2001-08-26 13:36:47  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.30  2001/08/01 21:46:41  peter
     * support pwidechar in typed const
 
   Revision 1.29  2001/07/30 21:39:26  peter

compiler/rautils.pas

@@ -217,12 +217,8 @@ uses
   strings,
 {$endif}
   types,systems,verbose,globals,
-  symsym,symtable,cpuasm
-{$ifdef NEWCG}
-  ,cgbase;
-{$else}
-  ,hcodegen;
-{$endif}
+  symsym,symtable,cpuasm,
+  cgbase;
 
 {*************************************************************************
                               TExprParse
@@ -1585,7 +1581,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.22  2001-08-12 17:57:07  peter
+  Revision 1.23  2001-08-26 13:36:48  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.22  2001/08/12 17:57:07  peter
     * under development flag for targets
 
   Revision 1.21  2001/08/06 21:40:48  peter

compiler/regvars.pas

@@ -48,7 +48,7 @@ implementation
       globtype,systems,comphook,
       cutils,cclasses,verbose,globals,
       symconst,symbase,symtype,symdef,types,
-      hcodegen,cpuasm,tgcpu;
+      cgbase,cpuasm,tgcpu;
 
     var
       parasym : boolean;
@@ -153,6 +153,7 @@ implementation
       regvarinfo: pregvarinfo;
       i: longint;
     begin
+{$ifdef i386}
       { max. optimizations     }
       { only if no asm is used }
       { and no try statement   }
@@ -245,7 +246,7 @@ implementation
                 { hold needed registers free }
 
                 { in non leaf procedures we must be very careful }
-                { with assigning registers             }
+                { with assigning registers                       }
                 if aktmaxfpuregisters=-1 then
                   begin
                    if (procinfo^.flags and pi_do_call)<>0 then
@@ -280,7 +281,8 @@ implementation
                   end;
               end;
         end;
-    end;
+{$endif i386}
+     end;
 
 
 {$ifdef i386}
@@ -518,7 +520,11 @@ end.
 
 {
   $Log$
-  Revision 1.17  2001-04-21 12:03:12  peter
+  Revision 1.18  2001-08-26 13:36:49  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.17  2001/04/21 12:03:12  peter
     * m68k updates merged from fixes branch
 
   Revision 1.16  2001/04/13 01:22:13  peter

compiler/symdef.pas

@@ -520,15 +520,13 @@ interface
           count      : boolean;
           is_used    : boolean;
           { small set which contains the modified registers }
-{$ifdef newcg}
-          usedregisters : tregisterset;
-{$else newcg}
 {$ifdef i386}
           usedregisters : longint;
-{$else}
-          usedregisters : tregisterset;
 {$endif}
-{$endif newcg}
+{$ifdef POWERPC}
+          { not used, only a fake }
+          usedregisters : longint;
+{$endif}
           constructor create;
           constructor load(ppufile:tcompilerppufile);
           destructor  destroy;override;
@@ -3327,9 +3325,12 @@ implementation
 {$else newcg}
 {$ifdef i386}
          usedregisters:=$ff;
-{$else}
-         usedregisters:=ALL_REGISTERS;
 {$endif i386}
+{$ifdef POWERPC}
+         { on the PPC, we use the OS specific standard calling conventions }
+         { so the information about the used register isn't necessary yet  }
+         usedregisters:=0;
+{$endif POWERPC}
 {$endif newcg}
          forwarddef:=true;
          interfacedef:=false;
@@ -3353,7 +3354,13 @@ implementation
 {$ifdef i386}
          usedregisters:=ppufile.getbyte;
 {$else}
+{$ifdef POWERPC}
+         { on the PPC, we use the OS specific standard calling conventions }
+         { so the information about the used register isn't necessary yet  }
+         usedregisters:=0;
+{$else POWERPC}
          readnormalset(usedregisters);
+{$endif POWERPC}
 {$endif}
 {$endif newcg}
          _mangledname:=stringdup(ppufile.getstring);
@@ -3439,7 +3446,13 @@ implementation
 {$ifdef i386}
              usedregisters:=$ff;
 {$else}
-             usedregisters:=[firstreg..lastreg];
+{$ifdef POWERPC}
+         { on the PPC, we use the OS specific standard calling conventions }
+         { so the information about the used register isn't necessary yet  }
+            usedregisters:=0;
+{$else POWERPC}
+            usedregisters:=[firstreg..lastreg];
+{$endif POWERPC}
 {$endif i386}
 {$endif newcg}
            end;
@@ -3450,7 +3463,12 @@ implementation
 {$ifdef i386}
          ppufile.putbyte(usedregisters);
 {$else}
-         writenormalset(usedregisters);
+{$ifdef POWERPC}
+         { on the PPC, we use the OS specific standard calling conventions }
+         { so the information about the used register isn't necessary yet  }
+{$else POWERPC}
+           writenormalset(usedregisters);
+{$endif POWERPC}
 {$endif i386}
 {$endif newcg}
          ppufile.do_interface_crc:=oldintfcrc;
@@ -5489,7 +5507,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.44  2001-08-22 21:16:22  florian
+  Revision 1.45  2001-08-26 13:36:49  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.44  2001/08/22 21:16:22  florian
     * some interfaces related problems regarding
       mapping of interface implementions fixed
 

compiler/symsym.pas

@@ -343,7 +343,7 @@ implementation
        { module }
        fmodule,
        { codegen }
-       hcodegen,cresstr
+       cgbase,cresstr
        ;
 
 {****************************************************************************
@@ -2240,7 +2240,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.18  2001-08-19 09:39:28  peter
+  Revision 1.19  2001-08-26 13:36:50  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.18  2001/08/19 09:39:28  peter
     * local browser support fixed
 
   Revision 1.16  2001/08/12 20:00:26  peter

compiler/symtable.pas

@@ -278,7 +278,7 @@ implementation
       gdb,
 {$endif GDB}
       { codegen }
-      hcodegen
+      cgbase
       ;
 
 
@@ -2071,7 +2071,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.41  2001-08-19 09:39:29  peter
+  Revision 1.42  2001-08-26 13:36:51  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.41  2001/08/19 09:39:29  peter
     * local browser support fixed
 
   Revision 1.40  2001/08/06 21:40:49  peter

compiler/tainst.pas

@@ -0,0 +1,271 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Michael Van Canneyt
+
+    Contains a generic assembler instruction object;
+
+    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 tainst;
+
+interface
+
+  Uses aasm,cpubase,cpuinfo,cclasses;
+
+Type
+
+tairegalloc = class(tai)
+   allocation : boolean;
+   reg        : tregister;
+   constructor alloc(r : tregister);
+   constructor dealloc(r : tregister);
+end;
+
+tainstruction = class(tai)
+  is_jmp    : boolean; { is this instruction a jump? (needed for optimizer) }
+  opcode    : tasmop;
+  condition : TAsmCond;
+  ops       : longint;
+  oper      : array[0..max_operands-1] of toper;
+  Constructor Create(op : tasmop);
+  Destructor Destroy;override;
+  function getcopy:tlinkedlistitem;virtual;
+  procedure loadconst(opidx:longint;l:longint);
+  procedure loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
+  procedure loadref(opidx:longint;p:preference);
+  procedure loadreg(opidx:longint;r:tregister);
+  procedure loadoper(opidx:longint;o:toper);
+  procedure SetCondition(c:TAsmCond);
+  end;
+
+implementation
+
+{*****************************************************************************
+                                 TaiRegAlloc
+*****************************************************************************}
+
+constructor tairegalloc.alloc(r : tregister);
+  begin
+    inherited create;
+    typ:=ait_regalloc;
+    allocation:=true;
+    reg:=r;
+  end;
+
+
+constructor tairegalloc.dealloc(r : tregister);
+  begin
+    inherited create;
+    typ:=ait_regalloc;
+    allocation:=false;
+    reg:=r;
+  end;
+
+{ ---------------------------------------------------------------------
+    TaInstruction Constructor/Destructor
+  ---------------------------------------------------------------------}
+
+
+
+Constructor tainstruction.Create(op : tasmop);
+
+begin
+   inherited create;
+   typ:=ait_instruction;
+   is_jmp:=false;
+   opcode:=op;
+   ops:=0;
+   fillchar(condition,sizeof(condition),0);
+   fillchar(oper,sizeof(oper),0);
+end;
+
+
+
+Destructor Tainstruction.Destroy;
+
+Var i : longint;
+
+begin
+  for i:=1 to ops do
+  if (oper[i-1].typ=top_ref) then
+    dispose(oper[i-1].ref);
+  inherited destroy;
+end;
+
+
+
+{ ---------------------------------------------------------------------
+    Loading of operands.
+  ---------------------------------------------------------------------}
+
+
+
+procedure tainstruction.loadconst(opidx:longint;l:longint);
+
+begin
+  if opidx>=ops then
+   ops:=opidx+1;
+  with oper[opidx] do
+   begin
+     if typ=top_ref then
+      disposereference(ref);
+     val:=l;
+     typ:=top_const;
+   end;
+end;
+
+
+
+procedure tainstruction.loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
+begin
+  if opidx>=ops then
+   ops:=opidx+1;
+  with oper[opidx] do
+   begin
+     if typ=top_ref then
+      disposereference(ref);
+     sym:=s;
+     symofs:=sofs;
+     typ:=top_symbol;
+   end;
+  { Mark the symbol as used }
+  if assigned(s) then
+   inc(s.refs);
+end;
+
+
+
+procedure tainstruction.loadref(opidx:longint;p:preference);
+begin
+  if opidx>=ops then
+   ops:=opidx+1;
+  with oper[opidx] do
+   begin
+     if typ=top_ref then
+      disposereference(ref);
+     if p^.is_immediate then
+       begin
+         val:=p^.offset;
+         disposereference(p);
+         typ:=top_const;
+       end
+     else
+       begin
+         ref:=p;
+{ We allow this exception for i386, since overloading this would be
+  too much of a a speed penalty}
+{$ifdef i386}
+         if not(ref^.segment in [R_DS,R_NO]) then
+           segprefix:=ref^.segment;
+{$endif}
+         typ:=top_ref;
+         { mark symbol as used }
+         if assigned(ref^.symbol) then
+           inc(ref^.symbol.refs);
+       end;
+   end;
+end;
+
+
+
+procedure tainstruction.loadreg(opidx:longint;r:tregister);
+begin
+  if opidx>=ops then
+   ops:=opidx+1;
+  with oper[opidx] do
+   begin
+     if typ=top_ref then
+      disposereference(ref);
+     reg:=r;
+     typ:=top_reg;
+   end;
+end;
+
+
+
+procedure tainstruction.loadoper(opidx:longint;o:toper);
+begin
+  if opidx>=ops then
+   ops:=opidx+1;
+  if oper[opidx].typ=top_ref then
+    disposereference(oper[opidx].ref);
+  oper[opidx]:=o;
+  { copy also the reference }
+  if oper[opidx].typ=top_ref then
+   oper[opidx].ref:=newreference(o.ref^);
+end;
+
+
+{ ---------------------------------------------------------------------
+    Miscellaneous methods.
+  ---------------------------------------------------------------------}
+
+procedure tainstruction.SetCondition(c:TAsmCond);
+  begin
+     condition:=c;
+  end;
+
+
+Function tainstruction.getcopy:tlinkedlistitem;
+
+var
+  i : longint;
+  p : tlinkedlistitem;
+begin
+  p:=inherited getcopy;
+  { make a copy of the references }
+  for i:=1 to ops do
+   if (tainstruction(p).oper[i-1].typ=top_ref) then
+    begin
+      new(tainstruction(p).oper[i-1].ref);
+      tainstruction(p).oper[i-1].ref^:=oper[i-1].ref^;
+    end;
+  getcopy:=p;
+end;
+
+end.
+
+{
+  $Log$
+  Revision 1.1  2001-08-26 13:36:52  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.1  2000/07/13 06:30:08  michael
+  + Initial import
+
+  Revision 1.6  2000/01/07 01:14:54  peter
+    * updated copyright to 2000
+
+  Revision 1.5  1999/09/10 18:48:11  florian
+    * some bug fixes (e.g. must_be_valid and procinfo.funcret_is_valid)
+    * most things for stored properties fixed
+
+  Revision 1.4  1999/09/03 13:10:11  jonas
+    * condition is now zeroed using fillchar\n    because on powerpc it's a record now
+
+  Revision 1.3  1999/08/26 14:52:59  jonas
+    * added segprefix field for i386 in tainstruction object
+
+  Revision 1.2  1999/08/06 16:38:37  jonas
+    * declared getcopy virtual, since it's already declared as such
+      in cobjects.pas (FPC doesn't error on that, TP does)
+
+  Revision 1.1  1999/08/06 16:04:05  michael
+  + introduced tainstruction
+
+}

compiler/temp_gen.pas

@@ -28,7 +28,7 @@ interface
 
     uses
       cpubase,cpuinfo,globals,
-      hcodegen,verbose,fmodule,aasm;
+      cgbase,verbose,fmodule,aasm;
 
 {$ifdef newcg}
     const
@@ -622,7 +622,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.17  2001-07-08 21:00:16  peter
+  Revision 1.18  2001-08-26 13:36:52  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.17  2001/07/08 21:00:16  peter
     * various widestring updates, it works now mostly without charset
       mapping supported