* obsolete

compiler/new/README

@@ -1,325 +0,0 @@
-$Id$
-
-Module CPUBASE
---------------
-
-   CONSTANTS used throughout the code generator
-   --------------------------------------------
-
-Must of this is subject to be moved to cpuinfo
-
-frame_pointer              equals the register used as frame pointer
-stack_pointer              equals the register used as stack pointer
-self_pointer               equals the register used as self pointer
-accumulator                equals the register which will be used
-                           as function return values
-
-
-unusedregsint              set of Currently available integer registers
-unusedregsfpu              set of Currently available fpu registers
-unusedregsmm               set of Currently available mm registers
-
-availabletempregsint       set of maximally available integer registers
-availabletempregsfpu       set of maximally available fpu registers
-availabletempregsmm        set of maximally available mm registers
-
-countusableregsint         count of currently available integer registers
-countusableregsfpu         count of currently available fpu registers
-countusableregsmm          count of currently available mm registers
-
-c_countusableregsint       count of max. available int registers (in the current procedure)
-c_countusableregsfpu       count of max. available fpu registers (in the current procedure)
-c_countusableregsmm        count of max. available mm registers (in the current procedure)
-
-intregs                    all!! available integer register
-fpuregs                    all!! available fpu register
-mmregs                     all!! available multimedia register
-
-lvaluelocations            a set of all locations which can be an l-value
-
-  Locations
-  ---------
-The first pass assigns these location types which are then
-used by the code generator to write out the correct instructions:
-
- LOC_INVALID    = This is an error and should never occur
- LOC_REGISTER   = Location is in a register
- LOC_MEM        = Memory reference (symbolic or register address?)
- LOC_REFERENCE  = Memory reference (symbolic or register address?)
- LOC_JUMP       = ????
- LOC_FLAGS      = Value is in the flags (Florian, this will give problems!)
- LOC_CREGISTER  = Value is in a constant register (across calls -
-                   used for optimizations) - Constant registers
-                  should not be directly modified????
- LOC_CONST      = Value is a numeric constant
-
-   Operand Sizes
-   -------------
- OS_NO       = No operand size.
- OS_8        = 8-bit signed or unsigned value
- OS_16       = 16-bit signed or unsigned value
- OS_32       = 32-bit signed or unsigned value
- OS_64       = 64-bit signed or unsigned value
-
-Intel specific
---------------
-unusedregssse
-availabletempregssse
-countusableregssse
-
-Jonas Maebe schrieb:
->
-> Hello,
->
-> Is there any difference between the localsize parameter of
-> g_stackframe_entry and the parasize parameter of g_return_from_proc, or
-> are they both the same value?
-
-They are different, I think the value of g_return_from_proc doesn't matter
-for the PowerPC. It's the size of parameters passed on the stack
-and only important for the i386/m68k probably.
-
->
-> And for the PowerPC, what will they contain? Just the size of the local
-> variables and parameters, or also the maximum needed size for parameters
-> of any procedure called by the current one (the caller must reserve space
-> for the callee's parameters on it's own stack because you can't push
-> values on the stack in the middle of a procedure (no frame pointer))
->
-> Jonas
-
-the parameter passed to g_stackframe_entry contains the size of the all local space which is
-needed
-except
-that one for saving registers: the set procinfo.registerstosave (not yet implemented,
-I'll commit it soon) will contain
-all registers which must be saved by the entry and restored by the exit code of a procedure
-and you have to add extra space to do that.
-
-The code generation
--------------------
-
-The code generation can be seperated into 3 layers:
-1. the method secondpass of the tnode childs
-2. the procedure variables p2_
-3. the code generator object
-
-1.: This procedure does very high level stuff, if the code generation
-is processor independent, it calls the appropriate procedures of the
-code generator object to generate the code, but in most cases, it
-calls procedure variables of the second layer
-
-2. This procedure variables must be initialized to match the
-current processor, these variables are used to optimize
-existing processor instructions(? CEC).
-
-The following procedure variables are currently used
-
-   Name                      Purpose                 Alternatives
------------------------------------------------------------------------------
-p2_assignment
-p2_assignment_int64_reg   Do an assignment of a int64
-
-
-3. The code generator object does very basic operations like generating
-move code etc, which is called by the p2_ functions and by the
-secondpass procedures.
-
-Alignment
----------
-
-The alignment is handled very easily: treference contains a field
-alignment which describes the ensured alignment for the node, possible
-values: 1,2,4,8,16 (1 means unligned). The code generator must update
-that field at the appropriate places and take care of it when
-generating the code
-
-MODULE CGOBJ (The code generator object)
-------------
-This is the basis of the code generator, it includes several
-template instructions which are used to create a processor
-independant code generator.
-
-Fields:
-    scratch_register_array_pointer : aword;
-     ?????????????????????
-       Indicates the free scratch registers?
-
-    unusedscratchregisters : tregisterset;
-       This holds the currently unused registers which can
-       be used as temporary placeholders.
-
-    alignment : talignment; ?? Why is this in cg object, should not
-    this be a constant instead?
-
-     Template instructions
-     ---------------------
-          procedure a_call_name
-
-          Call a routine by symbolic name with a possible
-          numeric offset value.
-
-
-
-???? WE ASSUME UNSIGNED???
-
-          { move instructions }
-          procedure a_load_const_reg
-          --------------------------
-          Move a constant value to a register
-
-          procedure a_load_reg_ref
-          ------------------------
-          Move a register value to a memory reference
-
-          procedure a_load_ref_reg
-          ------------------------
-          Move the value at a specified address into a register
-
-          procedure a_load_reg_reg
-          ------------------------
-          Move from register to register
-
-WE NEED !!!!MOVE WITH SIGN EXTENSION??????????????????????
-
-
-          {  comparison operations }
-????????????? WHAT DOES THE LABELS MEAN????????
-
-          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_cmp_reg_ref_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;reg : tregister;l : pasmlabel);
-          procedure a_cmp_ref_const_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
-            l : pasmlabel);
-
-          procedure a_jmp_cond(list : paasmoutput;cond : TOpCmp;l: pasmlabel);
-
-          procedure a_loadaddress_ref_reg(list : paasmoutput;const ref : treference;r : tregister);virtual;
-
-
-    ??????????????
-          { allocates register r by inserting a pai_realloc record }
-          procedure a_reg_alloc(list : paasmoutput;r : tregister);
-          { deallocates register r by inserting a pa_regdealloc record}
-          procedure a_reg_dealloc(list : paasmoutput;r : tregister);
-
-
-    { returns a register for use as scratch register }
-    function get_scratch_reg(list : paasmoutput) : tregister;
-    { releases a scratch register }
-    procedure free_scratch_reg(list : paasmoutput;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 : paasmoutput;t : pdef;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 : paasmoutput;t : pdef;const ref : treference;is_already_ref : boolean);
-
-          { helper routines }
-          procedure g_initialize_data(list : paasmoutput;p : psym);
-          procedure g_incr_data(list : paasmoutput;p : psym);
-          procedure g_finalize_data(list : paasmoutput;p : pnamedindexobject);
-          procedure g_copyvalueparas(list : paasmoutput;p : pnamedindexobject);
-          procedure g_finalizetempansistrings(list : paasmoutput);
-
-          procedure g_entrycode(list : paasmoutput;
-            const proc_names : tstringcontainer;make_global : boolean;
-            stackframe : longint;var parasize : longint;
-            var nostackframe : boolean;inlined : boolean);
-
-          procedure g_exitcode(list : paasmoutput;parasize : longint;
-            nostackframe,inlined : boolean);
-
-          { string helper routines }
-          procedure g_decrstrref(list : paasmoutput;const ref : treference;t : pdef);
-
-          procedure g_removetemps(list : paasmoutput;p : plinkedlist);
-
-          { 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;
-
-          {**********************************}
-          { 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
-          }
-Virtual instruction templates:
-
-
-
-
-          procedure g_stackframe_entry(list : paasmoutput;localsize : longint);virtual;
-          { restores the frame pointer at procedure exit, for the }
-          { i386 it generates a simple leave                      }
-          procedure g_restore_frame_pointer(list : paasmoutput);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 : paasmoutput;reg : tregister);virtual;
-          procedure g_push_exception_value_const(list : paasmoutput;reg : tregister);virtual;
-          { that procedure pops a exception value                             }
-          procedure g_pop_exception_value_reg(list : paasmoutput;reg : tregister);virtual;
-          procedure g_return_from_proc(list : paasmoutput;parasize : aword);virtual;
-          {********************************************************}
-          { these methods can be overriden for extra functionality }
-
-          { the following methods do nothing: }
-          procedure g_interrupt_stackframe_entry(list : paasmoutput);virtual;
-          procedure g_interrupt_stackframe_exit(list : paasmoutput);virtual;
-
-          procedure g_profilecode(list : paasmoutput);virtual;
-          procedure g_stackcheck(list : paasmoutput;stackframesize : longint);virtual;
-
-          procedure a_load_const_ref(list : paasmoutput;size : tcgsize;a : aword;const ref : treference);virtual;
-          procedure g_maybe_loadself(list : paasmoutput);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 : paasmoutput;const source,dest : treference;len : aword;loadref : boolean);virtual;
-
-          { uses the addr of ref as param, was emitpushreferenceaddr }
-          procedure a_param_ref_addr(list : paasmoutput;r : treference;nr : longint);virtual;
-
-
-
-
-CVS Log
--------
-
-$Log$
-Revision 1.3  2002-09-07 15:25:14  peter
-  * old logs removed and tabs fixed
-

compiler/new/agatt.pas

@@ -1,626 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 by Florian Klaempfl
-
-    This unit implements an abstract assembler write for GNU AT&T
-    assebler syntax
-
-    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 agatt;
-
-  interface
-
-    uses
-       globals,systems,{errors,}cobjects,aasm,strings,files,assemble,cpuasm
-{$ifdef GDB}
-       ,gdb
-{$endif GDB}
-       ,cpubase,globtype
-       ;
-
-    type
-      pattasmlist=^tattasmlist;
-      tattasmlist=object(tasmlist)
-        { convert an operand to a string }
-        function getopstr(const o:toper) : string;
-
-
-        { convert a treference to a string }
-        function getreferencestring(var ref : treference) : string; Virtual;
-        { convert a call/jmp operand to a string }
-        function getopstr_jmp(const o:toper) : string; Virtual;
-
-        { write an ait_instruction }
-        Procedure WriteInstruction (P : paicpu); virtual;
-
-
-        procedure WriteTree(p:paasmoutput);virtual;
-        procedure WriteAsmList;virtual;
-{$ifdef GDB}
-        procedure WriteFileLineInfo(var fileinfo : tfileposinfo);
-{$endif}
-      end;
-
-  implementation
-
-
-    function tattasmlist.getreferencestring(var ref : treference) : string;
-    begin
-      Abstract
-    End;
-
-    function tattasmlist.getopstr_jmp(const o:toper) : string;
-    Begin
-      Abstract
-    end;
-
-    Procedure tattasmlist.WriteInstruction (P : paicpu);
-    Begin
-      Abstract
-    End;
-
-
-    function tattasmlist.getopstr(const o:toper) : string;
-    var
-      hs : string;
-    begin
-      case o.typ of
-        top_reg :
-          getopstr:=att_reg2str[o.reg];
-        top_ref :
-          getopstr:=getreferencestring(o.ref^);
-        top_const :
-          getopstr:='$'+tostr(o.val);
-        top_symbol :
-          begin
-            if assigned(o.sym) then
-              hs:='$'+o.sym^.name
-            else
-              hs:='$';
-            if o.symofs>0 then
-             hs:=hs+'+'+tostr(o.symofs)
-            else
-             if o.symofs<0 then
-              hs:=hs+tostr(o.symofs)
-            else
-             if not(assigned(o.sym)) then
-               hs:=hs+'0';
-            getopstr:=hs;
-          end;
-        else
-{$ifndef testing}
-          internalerror(10001);
-{$else testing}
-          begin
-            writeln('internalerror 10001');
-            halt(1);
-          end;
-{$endif testing}
-      end;
-    end;
-
-
-
-
-{$ifdef GDB}
-      procedure tattasmlist.WriteFileLineInfo(var fileinfo : tfileposinfo);
-        var
-          curr_n : byte;
-        begin
-          if not (cs_debuginfo in aktmoduleswitches) then
-           exit;
-        { file changed ? (must be before line info) }
-          if (fileinfo.fileindex<>0) and
-             (stabslastfileinfo.fileindex<>fileinfo.fileindex) then
-           begin
-             infile:=current_module^.sourcefiles^.get_file(fileinfo.fileindex);
-             if includecount=0 then
-              curr_n:=n_sourcefile
-             else
-              curr_n:=n_includefile;
-             if (infile^.path^<>'') then
-              begin
-                AsmWriteLn(#9'.stabs "'+lower(BsToSlash(FixPath(infile^.path^,false)))+'",'+
-                  tostr(curr_n)+',0,0,'+'Ltext'+ToStr(IncludeCount));
-              end;
-             AsmWriteLn(#9'.stabs "'+lower(FixFileName(infile^.name^))+'",'+
-               tostr(curr_n)+',0,0,'+'Ltext'+ToStr(IncludeCount));
-             AsmWriteLn('Ltext'+ToStr(IncludeCount)+':');
-             inc(includecount);
-           end;
-        { line changed ? }
-          if (stabslastfileinfo.line<>fileinfo.line) and (fileinfo.line<>0) then
-           begin
-             if (n_line=n_textline) and assigned(funcname) and
-                (target_os.use_function_relative_addresses) then
-              begin
-                AsmWriteLn(target_asm.labelprefix+'l'+tostr(linecount)+':');
-                AsmWrite(#9'.stabn '+tostr(n_line)+',0,'+tostr(fileinfo.line)+','+
-                           target_asm.labelprefix+'l'+tostr(linecount)+' - ');
-                AsmWritePChar(FuncName);
-                AsmLn;
-                inc(linecount);
-              end
-             else
-              AsmWriteLn(#9'.stabd'#9+tostr(n_line)+',0,'+tostr(fileinfo.line));
-           end;
-          stabslastfileinfo:=fileinfo;
-        end;
-{$endif GDB}
-
-    procedure tattasmlist.WriteTree(p:paasmoutput);
-    const
-      allocstr : array[boolean] of string[10]=(' released',' allocated');
-    type
-      t64bitarray = array[0..7] of byte;
-      t32bitarray = array[0..3] of byte;
-    var
-      ch       : char;
-      hp       : pai;
-      consttyp : tait;
-      s        : string;
-      found    : boolean;
-      i,pos,l  : longint;
-      co       : comp;
-      sin      : single;
-      d        : double;
-      e        : extended;
-      op       : tasmop;
-      calljmp,
-      do_line  : boolean;
-      sep      : char;
-    begin
-      if not assigned(p) then
-       exit;
-      do_line:=(cs_debuginfo in aktmoduleswitches) or (cs_asm_source in aktglobalswitches);
-      hp:=pai(p^.first);
-      while assigned(hp) do
-       begin
-         aktfilepos:=hp^.fileinfo;
-         if do_line then
-          begin
-          { I think it is better to write stabs before source line PM }
-{$ifdef GDB}
-          { write stabs }
-            if cs_debuginfo in aktmoduleswitches then
-             begin
-               if not (hp^.typ in  [
-                      ait_label,
-                      ait_regalloc,ait_tempalloc,
-                      ait_stabn,ait_stabs,ait_section,
-                      ait_cut,ait_marker,ait_align,ait_stab_function_name]) then
-                 begin
-                    WriteFileLineInfo(hp^.fileinfo);
-                 end;
-             end;
-{$endif GDB}
-          { load infile }
-            if lastfileinfo.fileindex<>hp^.fileinfo.fileindex then
-             begin
-               infile:=current_module^.sourcefiles^.get_file(hp^.fileinfo.fileindex);
-               { open only if needed !! }
-               if (cs_asm_source in aktglobalswitches) then
-                 infile^.open;
-               { avoid unnecessary reopens of the same file !! }
-               lastfileinfo.fileindex:=hp^.fileinfo.fileindex;
-               { be sure to change line !! }
-               lastfileinfo.line:=-1;
-             end;
-          { write source }
-            if (cs_asm_source in aktglobalswitches) and
-                not (hp^.typ in  [
-                      ait_label,
-                      ait_stabn,ait_stabs,ait_section,
-                      ait_cut,ait_align,ait_stab_function_name]) then
-             begin
-               if (infile<>lastinfile) and assigned(lastinfile) then
-                 begin
-                   AsmWriteLn(target_asm.comment+'['+infile^.name^+']');
-                   lastinfile^.close;
-                 end;
-               if (hp^.fileinfo.line<>lastfileinfo.line) and
-                  (hp^.fileinfo.line<infile^.maxlinebuf) then
-                 begin
-                   if (hp^.fileinfo.line<>0) and
-                      (infile^.linebuf^[hp^.fileinfo.line]>=0) then
-                     AsmWriteLn(target_asm.comment+'['+tostr(hp^.fileinfo.line)+'] '+
-                       fixline(infile^.GetLineStr(hp^.fileinfo.line)));
-                   { set it to a negative value !
-                   to make that is has been read already !! PM }
-                   infile^.linebuf^[hp^.fileinfo.line]:=-infile^.linebuf^[hp^.fileinfo.line]-1;
-                end;
-               lastfileinfo:=hp^.fileinfo;
-               lastinfile:=infile;
-             end;
-          end;
-
-         case hp^.typ of
-
-           ait_comment :
-             Begin
-               AsmWrite(target_asm.comment);
-               AsmWritePChar(pai_asm_comment(hp)^.str);
-               AsmLn;
-             End;
-
-           ait_regalloc :
-             begin
-               if (cs_asm_regalloc in aktglobalswitches) then
-                 AsmWriteLn(target_asm.comment+'Register '+att_reg2str[pairegalloc(hp)^.reg]+
-                   allocstr[pairegalloc(hp)^.allocation]);
-             end;
-
-           ait_tempalloc :
-             begin
-               if (cs_asm_tempalloc in aktglobalswitches) then
-                 AsmWriteLn(target_asm.comment+'Temp '+tostr(paitempalloc(hp)^.temppos)+','+
-                   tostr(paitempalloc(hp)^.tempsize)+allocstr[paitempalloc(hp)^.allocation]);
-             end;
-
-           ait_align :
-             begin
-               AsmWrite(#9'.balign '+tostr(pai_align(hp)^.aligntype));
-               if pai_align(hp)^.use_op then
-                AsmWrite(','+tostr(pai_align(hp)^.fillop));
-               AsmLn;
-             end;
-
-           ait_section :
-             begin
-               if pai_section(hp)^.sec<>sec_none then
-                begin
-                  AsmLn;
-                  AsmWriteLn(ait_section2str(pai_section(hp)^.sec));
-{$ifdef GDB}
-                  lastfileinfo.line:=-1;
-{$endif GDB}
-                end;
-             end;
-
-           ait_datablock :
-             begin
-               if pai_datablock(hp)^.is_global then
-                AsmWrite(#9'.comm'#9)
-               else
-                AsmWrite(#9'.lcomm'#9);
-               AsmWrite(pai_datablock(hp)^.sym^.name);
-               AsmWriteLn(','+tostr(pai_datablock(hp)^.size));
-             end;
-
-           ait_const_32bit,
-           ait_const_16bit,
-           ait_const_8bit :
-             begin
-               AsmWrite(ait_const2str[hp^.typ]+tostr(pai_const(hp)^.value));
-               consttyp:=hp^.typ;
-               l:=0;
-               repeat
-                 found:=(not (Pai(hp^.next)=nil)) and (Pai(hp^.next)^.typ=consttyp);
-                 if found then
-                  begin
-                    hp:=Pai(hp^.next);
-                    s:=','+tostr(pai_const(hp)^.value);
-                    AsmWrite(s);
-                    inc(l,length(s));
-                  end;
-               until (not found) or (l>line_length);
-               AsmLn;
-             end;
-
-           ait_const_symbol :
-             begin
-               AsmWrite(#9'.long'#9+pai_const_symbol(hp)^.sym^.name);
-               if pai_const_symbol(hp)^.offset>0 then
-                 AsmWrite('+'+tostr(pai_const_symbol(hp)^.offset))
-               else if pai_const_symbol(hp)^.offset<0 then
-                 AsmWrite(tostr(pai_const_symbol(hp)^.offset));
-               AsmLn;
-             end;
-
-           ait_const_rva :
-             AsmWriteLn(#9'.rva'#9+pai_const_symbol(hp)^.sym^.name);
-
-           ait_real_64bit :
-             begin
-               if do_line then
-                AsmWriteLn(target_asm.comment+double2str(pai_real_64bit(hp)^.value));
-               d:=pai_real_64bit(hp)^.value;
-               AsmWrite(#9'.byte'#9);
-               for i:=0 to 7 do
-                begin
-                  if i<>0 then
-                   AsmWrite(',');
-                  AsmWrite(tostr(t64bitarray(d)[i]));
-                end;
-               AsmLn;
-             end;
-
-           ait_real_32bit :
-             begin
-               if do_line then
-                AsmWriteLn(target_asm.comment+single2str(pai_real_32bit(hp)^.value));
-               sin:=pai_real_32bit(hp)^.value;
-               AsmWrite(#9'.byte'#9);
-               for i:=0 to 3 do
-                begin
-                  if i<>0 then
-                   AsmWrite(',');
-                  AsmWrite(tostr(t32bitarray(sin)[i]));
-                end;
-               AsmLn;
-             end;
-
-           ait_comp_64bit :
-             begin
-               if do_line then
-                AsmWriteLn(target_asm.comment+comp2str(pai_comp_64bit(hp)^.value));
-               AsmWrite(#9'.byte'#9);
-{$ifdef FPC}
-               co:=comp(pai_comp_64bit(hp)^.value);
-{$else}
-               co:=pai_comp_64bit(hp)^.value;
-{$endif}
-               for i:=0 to 7 do
-                begin
-                  if i<>0 then
-                   AsmWrite(',');
-                  AsmWrite(tostr(t64bitarray(co)[i]));
-                end;
-               AsmLn;
-             end;
-
-           ait_direct :
-             begin
-               AsmWritePChar(pai_direct(hp)^.str);
-               AsmLn;
-{$IfDef GDB}
-               if strpos(pai_direct(hp)^.str,'.data')<>nil then
-                 n_line:=n_dataline
-               else if strpos(pai_direct(hp)^.str,'.text')<>nil then
-                 n_line:=n_textline
-               else if strpos(pai_direct(hp)^.str,'.bss')<>nil then
-                 n_line:=n_bssline;
-{$endif GDB}
-             end;
-
-           ait_string :
-             begin
-               pos:=0;
-               for i:=1 to pai_string(hp)^.len do
-                begin
-                  if pos=0 then
-                   begin
-                     AsmWrite(#9'.ascii'#9'"');
-                     pos:=20;
-                   end;
-                  ch:=pai_string(hp)^.str[i-1];
-                  case ch of
-                     #0, {This can't be done by range, because a bug in FPC}
-                #1..#31,
-             #128..#255 : s:='\'+tostr(ord(ch) shr 6)+tostr((ord(ch) and 63) shr 3)+tostr(ord(ch) and 7);
-                    '"' : s:='\"';
-                    '\' : s:='\\';
-                  else
-                   s:=ch;
-                  end;
-                  AsmWrite(s);
-                  inc(pos,length(s));
-                  if (pos>line_length) or (i=pai_string(hp)^.len) then
-                   begin
-                     AsmWriteLn('"');
-                     pos:=0;
-                   end;
-                end;
-             end;
-
-           ait_label :
-             begin
-               if (pai_label(hp)^.l^.is_used) then
-                begin
-                  if pai_label(hp)^.l^.typ=AS_GLOBAL then
-                    AsmWriteLn('.globl'#9+pai_label(hp)^.l^.name);
-                  AsmWriteLn(pai_label(hp)^.l^.name+':');
-                end;
-             end;
-
-           ait_symbol :
-             begin
-               if pai_symbol(hp)^.is_global then
-                AsmWriteLn('.globl'#9+pai_symbol(hp)^.sym^.name);
-               if target_info.target=target_i386_linux then
-                begin
-                   AsmWrite(#9'.type'#9+pai_symbol(hp)^.sym^.name);
-                   if assigned(pai(hp^.next)) and
-                      (pai(hp^.next)^.typ in [ait_const_symbol,ait_const_rva,
-                         ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_datablock,
-                         ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit]) then
-                    AsmWriteLn(',@object')
-                   else
-                    AsmWriteLn(',@function');
-                   if pai_symbol(hp)^.sym^.size>0 then
-                    AsmWriteLn(#9'.size'#9+pai_symbol(hp)^.sym^.name+', '+tostr(pai_symbol(hp)^.sym^.size));
-                end;
-               AsmWriteLn(pai_symbol(hp)^.sym^.name+':');
-             end;
-
-           ait_symbol_end :
-             begin
-               if target_info.target=target_i386_linux then
-                begin
-                  s:=target_asm.labelprefix+'e'+tostr(symendcount);
-                  inc(symendcount);
-                  AsmWriteLn(s+':');
-                  AsmWriteLn(#9'.size'#9+pai_symbol(hp)^.sym^.name+', '+s+' - '+pai_symbol(hp)^.sym^.name);
-                end;
-             end;
-
-           ait_instruction :  WriteInstruction(Hp);
-{$ifdef GDB}
-           ait_stabs :
-             begin
-               AsmWrite(#9'.stabs ');
-               AsmWritePChar(pai_stabs(hp)^.str);
-               AsmLn;
-             end;
-
-           ait_stabn :
-             begin
-               AsmWrite(#9'.stabn ');
-               AsmWritePChar(pai_stabn(hp)^.str);
-               AsmLn;
-             end;
-
-           ait_force_line :
-             stabslastfileinfo.line:=0;
-
-           ait_stab_function_name:
-             funcname:=pai_stab_function_name(hp)^.str;
-{$endif GDB}
-
-           ait_cut :
-             begin
-               if SmartAsm then
-                begin
-                { only reset buffer if nothing has changed }
-                  if AsmSize=AsmStartSize then
-                   AsmClear
-                  else
-                   begin
-                     AsmClose;
-                     DoAssemble;
-                     if pai_cut(hp)^.EndName then
-                      IsEndFile:=true;
-                     AsmCreate;
-                   end;
-                { avoid empty files }
-                  while assigned(hp^.next) and (pai(hp^.next)^.typ in [ait_cut,ait_section,ait_comment]) do
-                   begin
-                     if pai(hp^.next)^.typ=ait_section then
-                       lastsec:=pai_section(hp^.next)^.sec;
-                     hp:=pai(hp^.next);
-                   end;
-{$ifdef GDB}
-                  { force write of filename }
-                  FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0);
-                  includecount:=0;
-                  funcname:=nil;
-                  WriteFileLineInfo(hp^.fileinfo);
-{$endif GDB}
-                  if lastsec<>sec_none then
-                    AsmWriteLn(ait_section2str(lastsec));
-                  AsmStartSize:=AsmSize;
-                end;
-             end;
-
-           ait_marker :
-             ;
-
-           else
-{$ifndef testing}
-             internalerror(10000);
-{$else testing}
-             begin
-               writeln('internalerror 10001');
-               halt(1);
-             end;
-{$endif testing}
-         end;
-         hp:=pai(hp^.next);
-       end;
-    end;
-
-
-    procedure tattasmlist.WriteAsmList;
-    var
-      p:dirstr;
-      n:namestr;
-      e:extstr;
-{$ifdef GDB}
-      fileinfo : tfileposinfo;
-{$endif GDB}
-
-    begin
-{$ifdef EXTDEBUG}
-      if assigned(current_module^.mainsource) then
-       Comment(v_info,'Start writing att-styled assembler output for '+current_module^.mainsource^);
-{$endif}
-
-      LastSec:=sec_none;
-{$ifdef GDB}
-      FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0);
-{$endif GDB}
-      FillChar(lastfileinfo,sizeof(lastfileinfo),0);
-      LastInfile:=nil;
-
-      if assigned(current_module^.mainsource) then
-       fsplit(current_module^.mainsource^,p,n,e)
-      else
-       begin
-         p:=inputdir;
-         n:=inputfile;
-         e:=inputextension;
-       end;
-    { to get symify to work }
-      AsmWriteLn(#9'.file "'+FixFileName(n+e)+'"');
-
-{$ifdef GDB}
-      n_line:=n_bssline;
-      funcname:=nil;
-      linecount:=1;
-      includecount:=0;
-      fileinfo.fileindex:=1;
-      fileinfo.line:=1;
-      { Write main file }
-      WriteFileLineInfo(fileinfo);
-{$endif GDB}
-      AsmStartSize:=AsmSize;
-      symendcount:=0;
-
-      countlabelref:=false;
-      If (cs_debuginfo in aktmoduleswitches) then
-        WriteTree(debuglist);
-      WriteTree(codesegment);
-      WriteTree(datasegment);
-      WriteTree(consts);
-      WriteTree(rttilist);
-      Writetree(resourcestringlist);
-      WriteTree(bsssegment);
-      Writetree(importssection);
-      Writetree(exportssection);
-      Writetree(resourcesection);
-      countlabelref:=true;
-
-      AsmLn;
-{$ifdef EXTDEBUG}
-      if assigned(current_module^.mainsource) then
-       comment(v_info,'Done writing att-styled assembler output for '+current_module^.mainsource^);
-{$endif EXTDEBUG}
-    end;
-
-    Procedure tattasmlist.WriteInstruction (P : Pai); virtual;
-
-     begin
-       RunError(255);
-     end;
-end.
-{
- $Log$
- Revision 1.3  2004-06-20 08:55:31  florian
-   * logs truncated
-
-}

compiler/new/aopt.pas

@@ -1,247 +0,0 @@
-{
-    $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.3  2004-06-20 08:55:31  florian
-   * logs truncated
-
-}

compiler/new/aoptbase.pas

@@ -1,269 +0,0 @@
-{
-    $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 Pai 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: Pai): 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 Pai 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: Pai; Var Next: Pai): Boolean;
-    { gets the previous Pai 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: Pai; Var Last: Pai): 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: pai): Boolean; Virtual;
-    { returns whether P is a load constant instruction (load a constant }
-    { into a register)                                                  }
-    Function IsLoadConstReg(p: pai): 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: pai): Boolean; Virtual;
-
-    { create a paicpu Object that loads the contents of reg1 into reg2 }
-    Function a_load_reg_reg(reg1, reg2: TRegister): paicpu; 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: Pai): 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: Pai; Var Next: Pai): Boolean;
-Begin
-  Repeat
-    Current := Pai(Current^.Next);
-    While Assigned(Current) And
-          ((Current^.typ In SkipInstr) or
-           ((Current^.typ = ait_label) And
-            Not(Pai_Label(Current)^.l^.is_used))) Do
-      Current := Pai(Current^.Next);
-    If Assigned(Current) And
-       (Current^.typ = ait_Marker) And
-       (Pai_Marker(Current)^.Kind = NoPropInfoStart) Then
-      Begin
-        While Assigned(Current) And
-              ((Current^.typ <> ait_Marker) Or
-               (Pai_Marker(Current)^.Kind <> NoPropInfoEnd)) Do
-          Current := Pai(Current^.Next);
-      End;
-  Until Not(Assigned(Current)) Or
-        (Current^.typ <> ait_Marker) Or
-        (Pai_Marker(Current)^.Kind <> NoPropInfoEnd);
-  Next := Current;
-  If Assigned(Current) And
-     Not((Current^.typ In SkipInstr) or
-         ((Current^.typ = ait_label) And
-          Not(Pai_Label(Current)^.l^.is_used)))
-    Then GetNextInstruction := True
-    Else
-      Begin
-        Next := Nil;
-        GetNextInstruction := False;
-      End;
-End;
-
-Function TAOptBase.GetLastInstruction(Current: Pai; Var Last: Pai): Boolean;
-Begin
-  Repeat
-    Current := Pai(Current^.previous);
-    While Assigned(Current) And
-          (((Current^.typ = ait_Marker) And
-            Not(Pai_Marker(Current)^.Kind in [AsmBlockEnd,NoPropInfoEnd])) or
-           (Current^.typ In SkipInstr) or
-           ((Current^.typ = ait_label) And
-             Not(Pai_Label(Current)^.l^.is_used))) Do
-      Current := Pai(Current^.previous);
-    If Assigned(Current) And
-       (Current^.typ = ait_Marker) And
-       (Pai_Marker(Current)^.Kind = NoPropInfoEnd) Then
-      Begin
-        While Assigned(Current) And
-              ((Current^.typ <> ait_Marker) Or
-               (Pai_Marker(Current)^.Kind <> NoPropInfoStart)) Do
-          Current := Pai(Current^.previous);
-      End;
-  Until Not(Assigned(Current)) Or
-        (Current^.typ <> ait_Marker) Or
-        (Pai_Marker(Current)^.Kind <> NoPropInfoStart);
-  If Not(Assigned(Current)) or
-     (Current^.typ In SkipInstr) or
-     ((Current^.typ = ait_label) And
-      Not(Pai_Label(Current)^.l^.is_used)) or
-     ((Current^.typ = ait_Marker) And
-      (Pai_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: pai): Boolean;
-Begin
-  Abstract
-End;
-
-Function TAOptBase.IsLoadConstReg(p: pai): Boolean;
-Begin
-  Abstract
-End;
-
-Function TAOptBase.IsStoreRegMem(p: pai): Boolean;
-Begin
-  Abstract
-End;
-
-Function TAoptBase.a_load_reg_reg(reg1, reg2: TRegister): paicpu;
-Begin
-  Abstract
-End;
-
-End.
-
-{
-  $Log$
-  Revision 1.3  2004-06-20 08:55:31  florian
-    * logs truncated
-
-}

compiler/new/aoptcs.pas

@@ -1,856 +0,0 @@
-{
-    $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.3  2004-06-20 08:55:31  florian
-    * logs truncated
-
-}

compiler/new/aoptda.pas

@@ -1,183 +0,0 @@
-{
-    $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.3  2004-06-20 08:55:31  florian
-    * logs truncated
-
-}

compiler/new/aoptobj.pas

@@ -1,793 +0,0 @@
-{
-    $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, Cobjects, cpuinfo, cpubase, 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: Pai);
-    { 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: pai;
-    { 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 Pai 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 Pai 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: Pai;
-     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: Pai;
-  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: PAasmOutput;
-
-    { The labelinfo record contains the addresses of the Pai 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: Pai;
-
-    { _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: PAasmOutput; _BlockStart, _BlockEnd: Pai;
-                       _LabelInfo: PLabelInfo);
-
-    { processor independent methods }
-
-    { returns true if the label L is found between hp and the next }
-    { instruction                                                  }
-    Function FindLabel(L: PasmLabel; Var hp: Pai): Boolean;
-
-    { inserts new_one between prev and foll in AsmL }
-    Procedure InsertLLItem(prev, foll, new_one: PLinkedList_Item);
-
-
-    { If P is a Pai 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: Pai): Pai;
-
-    { 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 Pai's starting with StartPai and ending with the next "real"  }
-    { instruction                                                      }
-    Function FindRegAlloc(Reg: TRegister; StartPai: Pai): 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: Pai);
-{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(Pai_Label(p)^.l^.is_used))) Do
-         p := Pai(p^.next);
-    While Assigned(p) And
-          (p^.typ=ait_RegAlloc) Do
-      Begin
-        if pairegalloc(p)^.allocation then
-          UsedRegs := UsedRegs + [PaiRegAlloc(p)^.Reg]
-        else
-          UsedRegs := UsedRegs - [PaiRegAlloc(p)^.Reg];
-        p := pai(p^.next);
-      End;
-  Until Not(Assigned(p)) Or
-        (Not(p^.typ in SkipInstr) And
-         Not((p^.typ = ait_label) And
-            Not(Pai_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: Pai;
-    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, NrOfInstrSinceLastMod[Reg]);
-          PPaiProp(StartMod^.OptInfo)^.Regs[Reg].NrOfMods := NrOfMods;
-          NrOfInstrSinceLastMod[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))
-  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: Pai;
-  RefsEq: TRefCompare): Boolean;
-Var Count: AWord;
-    TmpResult: Boolean;
-Begin
-  TmpResult := False;
-  If (p^.typ = ait_instruction) Then
-    Begin
-      Count := 0;
-      Repeat
-        If (PInstr(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: Pai;
-    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: PAasmOutput; _BlockStart, _BlockEnd: Pai;
-                            _LabelInfo: PLabelInfo);
-Begin
-  AsmL := _AsmL;
-  BlockStart := _BlockStart;
-  BlockEnd := _BlockEnd;
-  LabelInfo := _LabelInfo
-End;
-
-Function TAOptObj.FindLabel(L: PasmLabel; Var hp: Pai): Boolean;
-Var TempP: Pai;
-Begin
-  TempP := hp;
-  While Assigned(TempP) and
-       (TempP^.typ In SkipInstr + [ait_label]) Do
-    If (TempP^.typ <> ait_Label) Or
-       (pai_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: PLinkedList_Item);
-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;
-            Pai(new_one)^.fileinfo := Pai(foll)^.fileinfo
-          End
-      End
-    Else AsmL^.Concat(new_one)
-  Else If Assigned(Foll) Then AsmL^.Insert(new_one)
-End;
-
-
-Function TAOptObj.SkipHead(P: Pai): Pai;
-Var OldP: Pai;
-Begin
-  Repeat
-    OldP := P;
-    If (P^.typ in SkipInstr) Or
-       ((P^.typ = ait_marker) And
-        (Pai_Marker(P)^.Kind = AsmBlockEnd)) Then
-      GetNextInstruction(P, P)
-    Else If ((P^.Typ = Ait_Marker) And
-        (Pai_Marker(P)^.Kind = NoPropInfoStart)) Then
- { a marker of the type NoPropInfoStart can't be the first instruction of a }
- { paasmoutput list                                                         }
-      GetNextInstruction(Pai(P^.Previous),P);
-    If (P^.Typ = Ait_Marker) And
-       (Pai_Marker(P)^.Kind = AsmBlockStart) Then
-      Begin
-        P := Pai(P^.Next);
-        While (P^.typ <> Ait_Marker) Or
-              (Pai_Marker(P)^.Kind <> AsmBlockEnd) Do
-          P := Pai(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: Pai): Boolean;
-Begin
-  FindRegAlloc:=False;
-  Repeat
-    While Assigned(StartPai) And
-          ((StartPai^.typ in (SkipInstr - [ait_regAlloc])) Or
-           ((StartPai^.typ = ait_label) and
-            Not(Pai_Label(StartPai)^.l^.Is_Used))) Do
-      StartPai := Pai(StartPai^.Next);
-    If Assigned(StartPai) And
-       (StartPai^.typ = ait_regAlloc) and (PairegAlloc(StartPai)^.allocation) Then
-      Begin
-        if PairegAlloc(StartPai)^.Reg = Reg then
-         begin
-           FindRegAlloc:=true;
-           exit;
-         end;
-        StartPai := Pai(StartPai^.Next);
-      End
-    else
-      exit;
-  Until false;
-End;
-
-End.
-
-{
- $Log$
- Revision 1.4  2004-06-20 08:55:31  florian
-   * logs truncated
-
-}

compiler/new/i386/aoptcpu.pas

@@ -1,45 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 by Jonas Maebe, member of the Free Pascal
-    Development Team
-
-    This unit implements the i386 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.3  2004-06-20 08:55:31  florian
-   * logs truncated
-
-}

compiler/new/i386/aoptcpub.pas

@@ -1,220 +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 aasm, cpubase, cpuasm, aoptbase;
-
-Type
-
-{ possible actions on an operand: read, write or modify (= read & write) }
-  TOpAction = (OpAct_Read, OpAct_Write, OpAct_Modify, OpAct_Unknown);
-
-{ type of a normal instruction }
-  TInstr = Taicpu;
-  PInstr = ^TInstr;
-
-  TFlag = (DirFlag);
-
-  TFlagContents = (F_Unknown, F_Clear, F_Set);
-
-{ ************************************************************************* }
-{ **************************** TCondRegs ********************************** }
-{ ************************************************************************* }
-{ Info about the conditional registers                                      }
-  TCondRegs = Object
-    Flags: Array[TFlag] of TFlagContents;
-    Constructor Init;
-    Procedure InitFlag(f: TFlag);
-    Procedure SetFlag(f: TFlag);
-    Procedure ClearFlag(f: TFlag);
-    Function GetFlag(f: TFlag): TFlagContents;
-    Destructor Done;
-  End;
-
-{ ************************************************************************* }
-{ **************************** TAoptBaseCpu ******************************* }
-{ ************************************************************************* }
-
-  TAoptBaseCpu = Object(TAoptBase)
-    Function RegMaxSize(Reg: TRegister): TRegister; Virtual;
-    Function RegsSameSize(Reg1, Reg2: TRegister): Boolean; Virtual;
-    Function IsLoadMemReg(p: pai): Boolean; Virtual;
-    Function IsLoadConstReg(p: pai): Boolean; Virtual;
-    Function IsStoreRegMem(p: pai): Boolean; Virtual;
-
-    Function a_load_reg_reg(reg1, reg2: TRegister): paicpu; virtual;
-  End;
-
-{ ************************************************************************* }
-{ ******************************* Constants ******************************* }
-{ ************************************************************************* }
-Const
-{ 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
-
-uses cpuinfo;
-
-{ ************************************************************************* }
-{ **************************** TCondRegs ********************************** }
-{ ************************************************************************* }
-Constructor TCondRegs.init;
-Begin
-  FillChar(Flags, SizeOf(Flags), Byte(F_Unknown))
-End;
-
-Procedure TCondRegs.InitFlag(f: TFlag);
-Begin
-  Flags[f] := F_Unknown
-End;
-
-Procedure TCondRegs.SetFlag(f: TFlag);
-Begin
-  Flags[f] := F_Set
-End;
-
-Procedure TCondRegs.ClearFlag(f: TFlag);
-Begin
-  Flags[f] := F_Clear
-End;
-
-Function TCondRegs.GetFlag(f: TFlag): TFlagContents;
-Begin
-  GetFlag := Flags[f]
-End;
-
-Destructor TCondRegs.Done; {$ifdef inl} inline; {$endif inl}
-Begin
-End;
-{ ************************************************************************* }
-{ **************************** TAoptBaseCpu ******************************* }
-{ ************************************************************************* }
-
-Function TAoptBaseCpu.RegMaxSize(Reg: TRegister): TRegister;
-Begin
-  RegMaxSize := Reg;
-  If (Reg >= R_AX)
-    Then
-      If (Reg <= R_DI)
-        Then RegMaxSize := Reg16ToReg32(Reg)
-        Else
-          If (Reg <= R_BL)
-            Then RegMaxSize := Reg8toReg32(Reg)
-End;
-
-Function TAOptBaseCpu.RegsSameSize(Reg1, Reg2: TRegister): Boolean;
-Begin
-  If (Reg1 <= R_EDI)
-    Then RegsSameSize := (Reg2 <= R_EDI)
-    Else
-      If (Reg1 <= R_DI)
-        Then RegsSameSize := (Reg2 in [R_AX..R_DI])
-        Else
-          If (Reg1 <= R_BL)
-            Then RegsSameSize := (Reg2 in [R_AL..R_BL])
-            Else RegsSameSize := False
-End;
-
-Function TAOptBaseCpu.IsLoadMemReg(p: pai): Boolean;
-Begin
-  IsLoadMemReg :=
-    (p^.typ = ait_instruction) and
-    ((PInstr(p)^.OpCode = A_MOV) or
-     (PInstr(p)^.OpCode = A_MOVZX) or
-     (PInstr(p)^.OpCode = A_MOVSX)) And
-    (PInstr(p)^.oper[LoadSrc].typ = top_ref);
-End;
-
-Function TAOptBaseCpu.IsLoadConstReg(p: pai): Boolean;
-Begin
-  IsLoadConstReg :=
-    (p^.typ = ait_instruction) and
-    (PInstr(p)^.OpCode = A_MOV) And
-    (PInstr(p)^.oper[LoadSrc].typ = top_const);
-End;
-
-Function TAOptBaseCpu.IsStoreRegMem(p: pai): Boolean;
-Begin
-  IsStoreRegMem :=
-    (p^.typ = ait_instruction) and
-    ((PInstr(p)^.OpCode = A_MOV) or
-     (PInstr(p)^.OpCode = A_MOVZX) or
-     (PInstr(p)^.OpCode = A_MOVSX)) And
-    (PInstr(p)^.oper[StoreDst].typ = top_ref);
-End;
-
-Function TAOptBaseCpu.a_load_reg_reg(reg1, reg2: TRegister): paicpu;
-Begin
-  a_load_reg_Reg := New(paicpu,Op_Reg_Reg(A_MOV, S_L, reg1, reg2))
-End;
-
-
-End.
-
-{
- $Log$
- Revision 1.3  2004-06-20 08:55:31  florian
-   * logs truncated
-
-}

compiler/new/i386/aoptcpuc.pas

@@ -1,91 +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
-  CpuBase,AOptCs;
-
-Type
-  TRegInfoCpu = Object(TRegInfo)
-    Procedure AddReg(OldReg, NewReg: TRegister); Virtual;
-  End;
-
-
-Implementation
-
-{ ********************* TRegInfoCpu *****************}
-
-Procedure TRegInfoCpu.AddReg(OldReg, NewReg: TRegister);
-Begin
-  NewRegsEncountered := NewRegsEncountered + [NewReg];
-  OldRegsEncountered := OldRegsEncountered + [OldReg];
-  New2OldReg[NewReg] := OldReg;
-  Case OldReg Of
-    R_EAX..R_EDI:
-      Begin
-        NewRegsEncountered := NewRegsEncountered + [Reg32toReg16(NewReg)];
-        OldRegsEncountered := OldRegsEncountered + [Reg32toReg16(OldReg)];
-        New2OldReg[Reg32toReg16(NewReg)] := Reg32toReg16(OldReg);
-        If (NewReg in [R_EAX..R_EBX]) And
-           (OldReg in [R_EAX..R_EBX]) Then
-          Begin
-            NewRegsEncountered := NewRegsEncountered + [Reg32toReg8(NewReg)];
-            OldRegsEncountered := OldRegsEncountered + [Reg32toReg8(OldReg)];
-            New2OldReg[Reg32toReg8(NewReg)] := Reg32toReg8(OldReg);
-          End;
-      End;
-    R_AX..R_DI:
-      Begin
-        NewRegsEncountered := NewRegsEncountered + [Reg16toReg32(NewReg)];
-        OldRegsEncountered := OldRegsEncountered + [Reg16toReg32(OldReg)];
-        New2OldReg[Reg16toReg32(NewReg)] := Reg16toReg32(OldReg);
-        If (NewReg in [R_AX..R_BX]) And
-           (OldReg in [R_AX..R_BX]) Then
-          Begin
-            NewRegsEncountered := NewRegsEncountered + [Reg16toReg8(NewReg)];
-            OldRegsEncountered := OldRegsEncountered + [Reg16toReg8(OldReg)];
-            New2OldReg[Reg16toReg8(NewReg)] := Reg16toReg8(OldReg);
-          End;
-      End;
-    R_AL..R_BL:
-      Begin
-        NewRegsEncountered := NewRegsEncountered + [Reg8toReg32(NewReg)]
-                           + [Reg8toReg16(NewReg)];
-        OldRegsEncountered := OldRegsEncountered + [Reg8toReg32(OldReg)]
-                           + [Reg8toReg16(OldReg)];
-        New2OldReg[Reg8toReg32(NewReg)] := Reg8toReg32(OldReg);
-      End;
-  End;
-End;
-
-End.
-{
-  $Log$
-  Revision 1.3  2004-06-20 08:55:31  florian
-    * logs truncated
-
-}

compiler/new/i386/aoptcpud.pas

@@ -1,241 +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 Aasm, cpubase, AoptCpub, AoptObj, AoptDA;
-
-Type
-  PAOptDFACpu = ^TAOptDFACpu;
-  TAOptDFACpu = Object(TAOptDFA)
-    { uses the same constructor as TAoptDFA = constructor from TAoptObj }
-
-    { handles the processor dependent dataflow analizing               }
-    Procedure CpuDFA(p: PInstr); Virtual;
-    Function TCh2Reg(Ch: TInsChange): TRegister; Virtual;
-    Function RegReadByInstr(Reg: TRegister; p: Pai): Boolean; Virtual;
-  End;
-
-Implementation
-
-uses cpuinfo;
-
-Procedure TAOptDFACpu.CpuDFA(p: PInstr);
-{ 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;
-    InstrProp: TInsProp;
-    TmpRef: TReference;
-    Cnt: Byte;
-Begin
-  CurProp := PPaiProp(p^.OptInfo);
-  Case p^.Opcode Of
-    A_DIV, A_IDIV, A_MUL:
-      Begin
-        CurProp^.ReadOp(p^.oper[0]);
-        CurProp^.ReadReg(R_EAX);
-        If (p^.OpCode = A_IDIV) or
-           (p^.OpCode = A_DIV) Then
-          CurProp^.ReadReg(R_EDX);
-        CurProp^.DestroyReg(R_EAX, InstrSinceLastMod)
-      End;
-    A_IMUL:
-      Begin
-        CurProp^.ReadOp(p^.oper[0]);
-        CurProp^.ReadOp(p^.oper[1]);
-        If (p^.oper[2].typ = top_none) Then
-          If (p^.oper[1].typ = top_none) Then
-            Begin
-              CurProp^.ReadReg(R_EAX);
-              CurProp^.DestroyReg(R_EAX, InstrSinceLastMod);
-              CurProp^.DestroyReg(R_EDX, InstrSinceLastMod)
-            End
-          Else
-            CurProp^.ModifyOp(p^.oper[1], InstrSinceLastMod)
-        Else
-          CurProp^.ModifyOp(p^.oper[2], InstrSinceLastMod);
-      End;
-    A_XOR:
-      Begin
-        CurProp^.ReadOp(p^.oper[0]);
-        CurProp^.ReadOp(p^.oper[1]);
-        If (p^.oper[0].typ = top_reg) And
-           (p^.oper[1].typ = top_reg) And
-           (p^.oper[0].reg = p^.oper[1].reg) Then
-          Begin
-            CurProp^.DestroyReg(p^.oper[0].reg, InstrSinceLastMod);
-            CurProp^.Regs[RegMaxSize(p^.oper[0].reg)].typ := Con_Const;
-            CurProp^.Regs[RegMaxSize(p^.oper[0].reg)].StartMod := Pointer(0)
-          End
-        Else
-          CurProp^.ModifyOp(p^.oper[1], InstrSinceLastMod);
-        End
-    Else
-      Begin
-        InstrProp := InsProp[p^.OpCode];
-        Cnt := 1;
-        While (Cnt <= MaxCh) And
-              (InstrProp.Ch[Cnt] <> Ch_None) Do
-          Begin
-            Case InstrProp.Ch[Cnt] Of
-              Ch_REAX..Ch_REDI:
-                CurProp^.ReadReg(TCh2Reg(InstrProp.Ch[Cnt]));
-              Ch_WEAX..Ch_RWEDI:
-                Begin
-                  If (InstrProp.Ch[Cnt] >= Ch_RWEAX) Then
-                    CurProp^.ReadReg(TCh2Reg(InstrProp.Ch[Cnt]));
-                  CurProp^.DestroyReg(TCh2Reg(InstrProp.Ch[Cnt]),InstrSinceLastMod);
-                End;
-              Ch_MEAX..Ch_MEDI:
-                CurProp^.ModifyReg(TCh2Reg(InstrProp.Ch[Cnt]), InstrSinceLastMod);
-              Ch_CDirFlag: CurProp^.CondRegs.ClearFlag(DirFlag);
-              Ch_SDirFlag: CurProp^.CondRegs.SetFlag(DirFlag);
-              Ch_Rop1: CurProp^.ReadOp(p^.oper[0]);
-              Ch_Rop2: CurProp^.ReadOp(p^.oper[1]);
-              Ch_Rop3: CurProp^.ReadOp(p^.oper[2]);
-              Ch_Wop1..Ch_RWop1:
-                Begin
-                  If (InstrProp.Ch[Cnt] = Ch_RWop1) Then
-                    CurProp^.ReadOp(p^.oper[0]);
-                  CurProp^.DestroyOp(p^.oper[0], InstrSinceLastMod);
-                End;
-              Ch_Mop1:
-                CurProp^.ModifyOp(p^.oper[0], InstrSinceLastMod);
-              Ch_Wop2..Ch_RWop2:
-                Begin
-                  If (InstrProp.Ch[Cnt] = Ch_RWop2) Then
-                    CurProp^.ReadOp(p^.oper[1]);
-                  CurProp^.DestroyOp(p^.oper[1], InstrSinceLastMod);
-                End;
-              Ch_Mop2:
-                CurProp^.ModifyOp(p^.oper[1], InstrSinceLastMod);
-              Ch_Wop3..Ch_RWop3:
-                Begin
-                  If (InstrProp.Ch[Cnt] = Ch_RWop3) Then
-                    CurProp^.ReadOp(p^.oper[2]);
-                  CurProp^.DestroyOp(p^.oper[2], InstrSinceLastMod);
-                End;
-              Ch_Mop3:
-                CurProp^.ModifyOp(p^.oper[2], InstrSinceLastMod);
-              Ch_WMemEDI:
-                Begin
-                  CurProp^.ReadReg(R_EDI);
-                  FillChar(TmpRef, SizeOf(TmpRef), 0);
-                  TmpRef.Base := R_EDI;
-                  CurProp^.DestroyRefs(TmpRef, R_NO, InstrSinceLastMod)
-                End;
-              Ch_RFlags, Ch_WFlags, Ch_RWFlags, Ch_FPU:;
-              Else CurProp^.DestroyAllRegs(InstrSinceLastMod)
-            End;
-            Inc(Cnt)
-          End
-      End
-  End
-End;
-
-Function TAOptDFACpu.RegReadByInstr(Reg: TRegister; p: Pai): Boolean;
-Var Cnt: AWord;
-    InstrProp: TInsProp;
-    TmpResult: Boolean;
-Begin
-  TmpResult := False;
-  If (p^.typ = ait_instruction) Then
-    Case PInstr(p)^.opcode of
-      A_IMUL:
-        With PInstr(p)^ Do
-          TmpResult :=
-            RegInOp(Reg,oper[0]) or
-            RegInOp(Reg,oper[1]) or
-            ((ops = 1) and
-             (reg = R_EAX));
-      A_DIV, A_IDIV, A_MUL:
-        With PInstr(p)^ Do
-          TmpResult :=
-            RegInOp(Reg,oper[0]) or
-            (Reg = R_EAX) or
-            ((Reg = R_EDX) and
-             ((opcode = A_DIV) or
-              (opcode = A_IDIV)) and
-             (opsize = S_L))
-      Else
-        Begin
-          Cnt := 1;
-          InstrProp := InsProp[PInstr(p)^.OpCode];
-          While (Cnt <= MaxCh) And
-                (InstrProp.Ch[Cnt] <> Ch_None) And
-                Not(TmpResult) Do
-            Begin
-              Case InstrProp.Ch[Cnt] Of
-                Ch_REAX..Ch_REDI,Ch_RWEAX..Ch_RWEDI
-                ,Ch_MEAX..Ch_MEDI
-                  TmpResult := Reg = TCh2Reg(InstrProp.Ch[Cnt]);
-                Ch_ROp1,Ch_RWOp1,Ch_Mop1:
-                  TmpResult := RegInOp(Reg,PInstr(p)^.oper[0]);
-                Ch_ROp2,Ch_RWOp2,Ch_Mop2:
-                  TmpResult := RegInOp(Reg,PInstr(p)^.oper[1]);
-                Ch_ROp3,Ch_RWOp3,Ch_Mop3:
-                  TmpResult := RegInOp(Reg,PInstr(p)^.oper[2]);
-                Ch_WOp1: TmpResult := (PInstr(p)^.oper[0].typ = top_ref) And
-                                     RegInRef(Reg,PInstr(p)^.oper[0].ref^);
-                Ch_WOp2: TmpResult := (PInstr(p)^.oper[1].typ = top_ref) And
-                                     RegInRef(Reg,PInstr(p)^.oper[1].ref^);
-                Ch_WOp3: TmpResult := (PInstr(p)^.oper[2].typ = top_ref) And
-                                     RegInRef(Reg,PInstr(p)^.oper[2].ref^);
-                Ch_WMemEDI: TmpResult := (Reg = R_EDI);
-                Ch_FPU: TmpResult := Reg in [R_ST..R_ST7,R_MM0..R_MM7]
-              End;
-              Inc(Cnt)
-            End
-        End
-    End;
-  RegReadByInstr := TmpResult
-End;
-
-Function TAOptDFACpu.TCh2Reg(Ch: TInsChange): TRegister;
-Begin
-  If (Ch <= Ch_REDI) Then
-    TCh2Reg := TRegister(Byte(Ch))
-  Else
-    If (Ch <= Ch_WEDI) Then
-      TCh2Reg := TRegister(Byte(Ch) - Byte(Ch_REDI))
-    Else
-      If (Ch <= Ch_RWEDI) Then
-        TCh2Reg := TRegister(Byte(Ch) - Byte(Ch_WEDI))
-      Else
-        If (Ch <= Ch_MEDI) Then
-          TCh2Reg := TRegister(Byte(Ch) - Byte(Ch_RWEDI))
-End;
-
-
-End.
-
-{
-  $Log$
-  Revision 1.4  2004-06-20 08:55:31  florian
-    * logs truncated
-
-}

compiler/new/powerpc/cpubase.pas

@@ -1,674 +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','dnzt','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 : (register64.reglo,register64.reghi : tregister);
-              { overlay a register64.reglo }
-              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.5  2004-10-31 21:45:03  peter
-    * generic tlocation
-    * move tlocation to cgutils
-
-  Revision 1.4  2001/09/09 17:10:26  jonas
-    * some more things implemented
-
-  Revision 1.3  2001/08/26 13:35:06  florian
-    * some cg reorganisation
-    * some PPC updates
-
-  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/symtable/symstack.pas

@@ -1,283 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 by Daniel Mantione
-     member of the Free Pascal development team
-
-    Commandline compiler for Free Pascal
-
-    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 symstack;
-
-interface
-
-uses    objects,symtable,globtype;
-
-const   cachesize=64;   {This should be a power of 2.}
-
-type    Tsymtablestack=object(Tobject)
-            srsym:Psym;                 {Result of the last search.}
-            srsymtable:Psymtable;
-            lastsrsym:Psym;             {Last sym found in statement.}
-            lastsrsymtable:Psymtable;
-            constructor init;
-            procedure clearcache;
-            procedure insert(s:Psym;addtocache:boolean);
-            function pop:Psymtable;
-            procedure push(s:Psymtable);
-            procedure search(const s:stringid;notfounderror:boolean);
-            function search_a_symtable(const symbol:stringid;symtabletype:pointer):Psym;
-            function top:Psymtable;
-            procedure topfree;
-            destructor done;virtual;
-        private
-            cache:array[1..cachesize] of Psym;
-            cachetables:array[1..cachesize] of Psymtable;
-            symtablestack:Tcollection;  {For speed reasons this is not
-                                         a pointer. A Tcollection is not
-                                         the perfect data structure for
-                                         a stack; it could be a good idea
-                                         to write an abstract stack object.}
-            procedure decache(s:Psymtable);
-        end;
-
-{$IFDEF STATISTICS}
-var hits,misses:longint;
-{$ENDIF STATISTICS}
-
-implementation
-
-uses    cobjects,symtablt,verbose,symbols,defs;
-
-var oldexit:pointer;
-
-constructor Tsymtablestack.init;
-
-begin
-    symtablestack.init(16,8);
-    clearcache;
-end;
-
-procedure Tsymtablestack.clearcache;
-
-begin
-    fillchar(cache,sizeof(cache),0);
-    fillchar(cachetables,sizeof(cache),0);
-end;
-
-procedure Tsymtablestack.decache(s:Psymtable);
-
-var p,endp:^Psymtable;
-    q:^Psym;
-
-begin
-    {Must be fast, otherwise the speed advantage is lost!
-     Therefore, the cache should not be too large...}
-    p:=@cachetables;
-    endp:=pointer(longint(@cachetables)+cachesize*sizeof(pointer));
-    q:=@cache;
-    repeat
-        if p^=s then
-            begin
-                p^:=nil;
-                q^:=nil;
-            end;
-        inc(p);
-        inc(q);
-    until p=endp;
-end;
-
-procedure Tsymtablestack.search(const s:stringid;notfounderror:boolean);
-
-var speedvalue,entry:longint;
-    i:word;
-
-begin
-    speedvalue:=getspeedvalue(s);
-    lastsrsym:=nil;
-    {Check the cache.}
-    entry:=(speedvalue and cachesize-1)+1;
-    if (cache[entry]<>nil) and (cache[entry]^.speedvalue=speedvalue) and
-     (cache[entry]^.name=s) then
-        begin
-            {Cache hit!}
-            srsym:=cache[entry];
-            srsymtable:=cachetables[entry];
-            {$IFDEF STATISTICS}
-            inc(hits);
-            {$ENDIF STATISTICS}
-        end
-    else
-        begin
-            {Cache miss. :( }
-            {$IFDEF STATISTICS}
-            inc(misses);
-            {$ENDIF STATISTICS}
-            for i:=symtablestack.count-1 downto 0 do
-                begin
-                    srsymtable:=Psymtable(symtablestack.at(i));
-                    srsym:=srsymtable^.speedsearch(s,speedvalue);
-                    if srsym<>nil then
-                        begin
-                            {Found! Place it in the cache.}
-                            cache[entry]:=srsym;
-                            cachetables[entry]:=srsymtable;
-                            exit;
-                        end
-                end;
-            {Not found...}
-            srsym:=nil;
-            if notfounderror then
-                begin
-                    message1(sym_e_id_not_found,s);
-                    srsym:=generrorsym;
-                end;
-        end;
-end;
-
-function Tsymtablestack.pop:Psymtable;
-
-var r:Psymtable;
-
-begin
-    r:=symtablestack.at(symtablestack.count);
-    decache(r);
-    pop:=r;
-    symtablestack.atdelete(symtablestack.count);
-end;
-
-procedure Tsymtablestack.push(s:Psymtable);
-
-begin
-    symtablestack.insert(s);
-end;
-
-procedure Tsymtablestack.insert(s:Psym;addtocache:boolean);
-
-var pretop,sttop:Psymtable;
-    hsym:Psym;
-    entry:longint;
-
-begin
-    sttop:=Psymtable(symtablestack.at(symtablestack.count));
-    pretop:=Psymtable(symtablestack.at(symtablestack.count-1));
-    if typeof(sttop^)=typeof(Timplsymtable) then
-        begin
-            {There must also be an interface symtable...}
-            if pretop^.speedsearch(s^.name,s^.speedvalue)<>nil then
-                duplicatesym(s);
-        end;
-    {Check for duplicate field id in inherited classes.}
-    if sttop^.is_object(typeof(Tobjectsymtable)) and
-     (Pobjectsymtable(sttop)^.defowner<>nil) then
-        begin
-            {Even though the private symtable is disposed and set to nil
-             after the unit has been compiled, we will still have to check
-             for a private sym, because of interdependend units.}
-            hsym:=Pobjectdef(Pobjectsymtable(sttop)^.defowner)^.
-             speedsearch(s^.name,s^.speedvalue);
-            if (hsym<>nil) and
-             (hsym^.is_object(typeof(Tprocsym))
-              and (sp_private in Pprocsym(hsym)^.objprop)) and
-             (hsym^.is_object(typeof(Tvarsym))
-              and (sp_private in Pvarsym(hsym)^.objprop)) then
-                duplicatesym(hsym);
-        end;
-    entry:=(s^.speedvalue and cachesize-1)+1;
-    if s^.is_object(typeof(Tenumsym)) and
-     sttop^.is_object(Tabstractrecordsymtable)) then
-        begin
-            if pretop^.insert(s) and addtocache then
-                begin
-                    cache[entry]:=s;
-                    cachetables[entry]:=pretop;
-                end;
-        end
-    else
-        begin
-            if sttop^.insert(s) and addtocache then
-                begin
-                    cache[entry]:=s;
-                    cachetables[entry]:=top;
-                end;
-        end;
-end;
-
-function Tsymtablestack.top:Psymtable;
-
-begin
-    top:=symtablestack.at(symtablestack.count);
-end;
-
-function Tsymtablestack.search_a_symtable(const symbol:stringid;symtabletype:pointer):Psym;
-
-{Search for a symbol in a specified symbol table. Returns nil if
- the symtable is not found, and also if the symbol cannot be found
- in the desired symtable.}
-
-var hsymtab:Psymtable;
-    res:Psym;
-    i:word;
-
-begin
-    res:=nil;
-    for i:=symtablestack.count-1 downto 0 do
-        if typeof((Psymtable(symtablestack.at(i))^))=symtabletype then
-            begin
-                {We found the desired symtable. Now check if the symbol we
-                 search for is defined in it }
-                res:=hsymtab^.search(symbol);
-                break;
-            end;
-    search_a_symtable:=res;
-end;
-
-procedure Tsymtablestack.topfree;
-
-begin
-    decache(symtablestack.at(symtablestack.count));
-    symtablestack.atfree(symtablestack.count);
-end;
-
-destructor Tsymtablestack.done;
-
-begin
-    symtablestack.done;
-end;
-
-{$IFDEF STATISTICS}
-
-procedure exitprocedure;{$IFDEF TP}far;{$ENDIF}
-
-begin
-    writeln('Symbol cache statistics:');
-    writeln('------------------------');
-    writeln;
-    writeln('Hits:             ',hits);
-    writeln('Misses:           ',misses);
-    writeln;
-    writeln('Hit percentage:   ',(hits*100) div (hits+misses),'%');
-    exitproc:=oldexit;
-end;
-
-begin
-    hits:=0;
-    misses:=0;
-    oldexit:=exitproc;
-    exitproc:=@exitprocedure;
-{$ENDIF STATISTICS}
-end.