ORCA-C/DAG.pas

{$optimize 7}
{---------------------------------------------------------------}
{                                                               }
{  DAG Creation							}
{                                                               }
{  Places intermediate codes into DAGs and trees.		}
{                                                               }
{---------------------------------------------------------------}

unit DAG;

interface

{$segment 'DAG'}

{$LibPrefix '0/obj/'}

uses CCommon, CGI, CGC, Gen;

{---------------------------------------------------------------}

procedure DAG (code: icptr);

{ place an op code in a DAG or tree				}
{                                                               }
{ parameters:                                                   }
{       code - opcode						}


function TypeOf (op: icptr): baseTypeEnum;

{---------------------------------------------------------------}

implementation

var
   c_ind: iclist;			{vars that can be changed by indirect stores}
   maxLoc: integer;			{max local label number used by compiler}
   memberOp: icptr;			{operation found by Member}
   optimizations: array[pcodes] of integer; {starting indexes into peeptable}
   peepTablesInitialized: boolean;	{have the peephole tables been initialized?}
   rescan: boolean;			{redo the optimization pass?}

{-- External unsigned math routines; imported from Expression.pas --}

function udiv (x,y: longint): longint; extern;

function umod (x,y: longint): longint; extern;

function umul (x,y: longint): longint; extern;

function lshr (x,y: longint): longint; extern;

{-- External 64-bit math routines; imported from Expression.pas --}
{ Procedures for arithmetic and shifts compute "x := x OP y".   }

procedure umul64 (var x: longlong; y: longlong); extern;

procedure udiv64 (var x: longlong; y: longlong); extern;

procedure div64 (var x: longlong; y: longlong); extern;

procedure umod64 (var x: longlong; y: longlong); extern;

procedure rem64 (var x: longlong; y: longlong); extern;

procedure add64 (var x: longlong; y: longlong); extern;

procedure sub64 (var x: longlong; y: longlong); extern;

procedure shl64 (var x: longlong; y: integer); extern;

procedure ashr64 (var x: longlong; y: integer); extern;

procedure lshr64 (var x: longlong; y: integer); extern;

{---------------------------------------------------------------}

function CodesMatch (op1, op2: icptr; exact: boolean): boolean;

{ Check to see if the trees op1 and op2 are equivalent		}
{								}
{ parameters:							}
{    op1, op2 - trees to check					}
{    exact - is an exact match of operands required?		}
{								}
{ Returns: True if trees are equivalent, else false.		}


   function LongStrCmp (s1, s2: longStringPtr): boolean;

   { Are the strings s1 and s2 equal?				}
   {								}
   { parameters:						}
   {    s1, s2 - strings to compare				}
   {								}
   { Returns: True if the strings are equal, else false		}

   label 1;

   var
      i: integer;			{loop/index variable}

   begin {LongStrCmp}
   LongStrCmp := false;
   if s1^.length = s2^.length then begin
      for i := 1 to s1^.length do
         if s1^.str[i] <> s2^.str[i] then
            goto 1;
      LongStrCmp := true;
      end; {if}
1:
   end; {LongStrCmp}


   function OpsEqual (op1, op2: icptr): boolean;

   { See if the operands are equal				}
   {								}
   { parameters:						}
   {    op1, op2 - operations to check				}
   {								}
   { Returns: True if the operands are equivalent, else		}
   {    false.							}

   var
      result: boolean;			{temp result}

   begin {OpsEqual}
   result := false;
   case op1^.opcode of
      pc_cup, pc_cui, pc_tl1, pc_bno:
         {this rule prevents optimizations from removing sensitive operations}
         ;

      pc_adi, pc_adl, pc_adr, pc_and, pc_lnd, pc_bnd, pc_bal, pc_bor,
      pc_blr, pc_bxr, pc_blx, pc_equ, pc_neq, pc_ior, pc_lor, pc_mpi,
      pc_umi, pc_mpl, pc_uml, pc_mpr, pc_bqr, pc_bqx, pc_baq, pc_adq,
      pc_mpq, pc_umq: begin
         if op1^.left = op2^.left then
            if op1^.right = op2^.right then
               result := true;
         if not result then
            if op1^.left = op2^.right then
               if op1^.right = op2^.left then
                  result := true;
         if not result then
            if not exact then
               if CodesMatch(op1^.left, op2^.left, false) then
                  if CodesMatch(op1^.right, op2^.right, false) then
                     result := true;
         if not result then
            if not exact then
               if CodesMatch(op1^.left, op2^.right, false) then
                  if CodesMatch(op1^.right, op2^.left, false) then
                     result := true;
         end;

      otherwise: begin
         if op1^.left = op2^.left then
            if op1^.right = op2^.right then
               result := true;
         if not result then
            if not exact then
               if CodesMatch(op1^.left, op2^.left, false) then
                  if CodesMatch(op1^.right, op2^.right, false) then
                     result := true;
         end;                 
      end; {case}
   OpsEqual := result;
   end; {OpsEqual}


begin {CodesMatch}
CodesMatch := false;
if op1 = op2 then
   CodesMatch := true
else if (op1 <> nil) and (op2 <> nil) then
   if op1^.opcode = op2^.opcode then
      if op1^.q = op2^.q then
         if op1^.r = op2^.r then
            if op1^.s = op2^.s then
               if (op1^.lab = op2^.lab) or (op1^.lab^ = op2^.lab^) then
                  if OpsEqual(op1, op2) then
                     if op1^.optype = op2^.optype then
                        case op1^.optype of
                           cgByte, cgUByte, cgWord, cgUWord:
                              if op1^.opnd = op2^.opnd then
                                 if op1^.llab = op2^.llab then
                                    if op1^.slab = op2^.slab then
                                       CodesMatch := true;
                           cgLong, cgULong:
                              if op1^.lval = op2^.lval then
                                 CodesMatch := true;
                           cgQuad, cgUQuad:
                              if op1^.qval.lo = op2^.qval.lo then
                                 if op1^.qval.hi = op2^.qval.hi then
                                    CodesMatch := true;
                           cgReal, cgDouble, cgComp, cgExtended:
                              if op1^.rval = op2^.rval then
                                 if (SignBit(op1^.rval) = SignBit(op2^.rval))
                                    or fastMath then
                                    CodesMatch := true;
                           cgString:
                              CodesMatch := LongStrCmp(op1^.str, op2^.str);
                           cgVoid, ccPointer:
                              if op1^.pval = op2^.pval then
                                 CodesMatch := LongStrCmp(op1^.str, op2^.str);
                           end; {case}
end; {CodesMatch}

{- Peephole Optimization ---------------------------------------}

function Base (val: longint): integer;

{ Assuming val is a power of 2, find ln(val) base 2		}
{								}
{ parameters:							}
{    val - value for which to find the base			}
{								}
{ Returns: ln(val), base 2					}

var
   i: integer;                    	{base counter}

begin {Base}
i := 0;
while not odd(val) do begin
   val := val >> 1;
   i := i+1;
   end; {while}
Base := i;
end; {Base}


procedure BinOps (var op1, op2: icptr);

{ Make sure the operands are of the same type			}
{								}
{ parameters:							}
{    op1, op2: two pc_ldc operands				}

var
   opt1, opt2: baseTypeEnum;		{temp operand types}

begin {BinOps}
opt1 := op1^.optype;
opt2 := op2^.optype;
if opt1 = cgByte then begin
   op1^.optype := cgWord;
   opt1 := cgWord;
   end {if}
else if opt1 = cgUByte then begin
   op1^.optype := cgWord;
   opt1 := cgWord;
   end {else if}
else if opt1 in [cgReal, cgDouble, cgComp] then begin
   op1^.optype := cgExtended;
   opt1 := cgExtended;
   end; {else if}
if opt2 = cgByte then begin
   op2^.optype := cgWord;
   opt2 := cgWord;
   end {if}
else if opt2 = cgUByte then begin
   op2^.optype := cgWord;
   opt2 := cgWord;
   end {else if}
else if opt2 in [cgReal, cgDouble, cgComp] then begin
   op2^.optype := cgExtended;
   opt2 := cgExtended;
   end; {else if}

if opt1 <> opt2 then begin
   case opt1 of
      cgWord:
         case opt2 of
            cgUWord:
               op1^.optype := cgUWord;
            cgLong, cgULong: begin
               op1^.lval := op1^.q;
               op1^.optype := opt2;
               end;
            cgExtended: begin
               op1^.rval := op1^.q;
               op1^.optype := cgExtended;
               end;
            otherwise: ;
            end; {case}
      cgUWord:
         case opt2 of
            cgWord:
               op2^.optype := cgUWord;
            cgLong, cgULong: begin
               op1^.lval := ord4(op1^.q) & $0000FFFF;
               op1^.optype := opt2;
               end;
            cgExtended: begin
               op1^.rval := ord4(op1^.q) & $0000FFFF;
               op1^.optype := cgExtended;
               end;
            otherwise: ;     
            end; {case}
      cgLong:
         case opt2 of
            cgWord: begin
               op2^.lval := op2^.q;
               op2^.optype := cgLong;
               end;
            cgUWord: begin
               op2^.lval := ord4(op2^.q) & $0000FFFF;
               op2^.optype := cgLong;
               end;
            cgULong:
               op1^.optype := cgULong;
            cgExtended: begin
               op1^.rval := op1^.lval;
               op1^.optype := cgExtended;
               end;
            otherwise: ;
            end; {case}
      cgULong:
         case opt2 of
            cgWord: begin
               op2^.lval := op2^.q;
               op2^.optype := cgLong;
               end;
            cgUWord: begin
               op2^.lval := ord4(op2^.q) & $0000FFFF;
               op2^.optype := cgLong;
               end;
            cgLong:
               op2^.optype := cgULong;
            cgExtended: begin
               op1^.rval := op1^.lval;
               if op1^.rval < 0.0 then
                  op1^.rval := 4294967296.0 + op1^.rval;
               op1^.optype := cgExtended;
               end;
            otherwise: ;
            end; {case}
      cgExtended: begin
         case opt2 of
            cgWord:
               op2^.rval := op2^.q;
            cgUWord:
               op2^.rval := ord4(op2^.q) & $0000FFFF;
            cgLong:
               op2^.rval := op2^.lval;
            cgULong: begin
               op2^.rval := op2^.lval;
               if op2^.rval < 0.0 then
                  op2^.rval := 4294967296.0 + op2^.rval;
               end;
            otherwise: ;
            end; {case}
         op2^.optype := cgExtended;
         end;
      otherwise: ;
      end; {case}
   end; {if}
end; {BinOps}


procedure CheckLabels;

{ remove unused dc_lab labels					}

var
   lop: icptr;				{predecessor of op}
   op: icptr;				{used to trace the opcode list}


   function Used (lab: integer): boolean;

   { see if a label is used					}
   {								}
   { parameters:						}
   {    lab - label number to check				}
   {								}
   { Returns: True if the label is used, else false.		}

   var
      found: boolean;			{was the label found?}
      op: icptr;			{used to trace the opcode list}
   
   begin {Used}
   found := false;
   op := DAGhead;
   while (not found) and (op <> nil) do begin
      if op^.opcode in [pc_add, pc_fjp, pc_tjp, pc_ujp] then
         found := op^.q = lab
      else if op^.opcode = pc_nat then
         found := true;
      op := op^.next;
      end; {while}
   Used := found;
   end; {Used}


begin {CheckLabels}
op := DAGhead;
while op^.next <> nil do begin
   lop := op;
   op := op^.next;
   if op^.opcode = dc_lab then
      if not Used(op^.q) then begin
         lop^.next := op^.next;
         op := lop;
         rescan := true;
         end; {if}
   end; {while}
end; {CheckLabels}


procedure RemoveDeadCode (op: icptr);

{ remove dead code following an unconditional branch		}
{								}
{ parameters:							}
{    op - unconditional branch opcode				}

begin {RemoveDeadCode}
while not (op^.next^.opcode in [dc_lab, dc_enp, dc_cns, dc_glb,
   dc_dst, dc_str, dc_pin, pc_ent, dc_loc, dc_prm, dc_sym]) do begin
   op^.next := op^.next^.next;
   rescan := true;
   end; {while}
end; {RemoveDeadCode}


function NoFunctions (op: icptr): boolean;

{ are there any function calls?					}
{								}
{ parameters:							}
{    op - operation tree to search				}
{								}
{ returns: True if there are no pc_cup or pc_cui operations	}
{    in the tree, else false.					}

begin {NoFunctions}
if op = nil then
   NoFunctions := true
else if op^.opcode in [pc_cup,pc_cui,pc_tl1] then
   NoFunctions := false
else
   NoFunctions := NoFunctions(op^.left) or NoFunctions(op^.right);
end; {NoFunctions}


function OneBit (val: longint): boolean;

{ See if there is exactly one bit set in val			}
{								}
{ parameters:							}
{    val - value to check					}
{								}
{ Returns: True if exactly one bit is set, else false		}

begin {OneBit}
if val = 0 then
   OneBit := false
else begin
   while not odd(val) do
      val := val >> 1;
   OneBit := val = 1;
   end; {else}
end; {OneBit}


procedure PeepHoleOptimization (var opv: icptr);

{ do peephole optimization on a list of opcodes			}
{								}
{ parameters:							}
{    opv - pointer to the first opcode				}
{								}
{ Notes:							}
{    1.	Many optimizations assume the children have already	}
{	been optimized.  In particular, many optimizations	}
{	depend on pc_ldc operands being on a specific side of	}
{	a child's expression tree.  (e.g. pc_fjp and pc_equ)	}

var
   done: boolean;			{optimization done test}
   doit: boolean;			{should we do the optimization?}
   lq, lval: longint;			{temps for long calculations}
   op2,op3: icptr;			{temp opcodes}
   op: icptr;				{copy of op (for efficiency)}
   opcode: pcodes;			{temp opcode}
   optype: baseTypeEnum;		{temp optype}
   q: integer;				{temp for integer calculations}
   rval: extended;			{temp for real calculations}

   fromtype, totype, firstType: record	{for converting numbers to optypes}
      case boolean of
         true:  (i: integer);
         false: (optype: baseTypeEnum);
      end;


   function SideEffects (op: icptr): boolean;

   { Check a tree for operations that have side effects	}
   {								}
   { parameters:						}
   {    op - tree to check					}

   var
      result: boolean;		{temp result}

   begin {SideEffects}
   if op = nil then begin
      if volatile then
         SideEffects := true
      else
         SideEffects := false
      end {if}
   else if op^.opcode in
      [pc_mov,pc_cbf,pc_cop,pc_cpi,pc_cpo,pc_gil,pc_gli,pc_gdl,
       pc_gld,pc_iil,pc_ili,pc_idl,pc_ild,pc_lil,pc_lli,pc_ldl,
       pc_lld,pc_sbf,pc_sro,pc_sto,pc_str,pc_cui,pc_cup,pc_tl1,
       pc_fix] then
      SideEffects := true
   else if op^.opcode = pc_ldc then
      SideEffects := false
   else
      SideEffects := SideEffects(op^.left) or SideEffects(op^.right);
   end; {SideEffects}


   procedure JumpOptimizations (op: icptr; newOpcode: pcodes);

   { handle common code for jump optimizations			}
   {								}
   { parameters:						}
   {    op - jump opcode					}
   {    newOpcode - opcode to use if the jump sense is reversed	}

   var
      done: boolean;			{optimization done test}
      topcode: pcodes;			{temp opcode}

   begin {JumpOptimizations}
   topcode := op^.left^.opcode;
   if topcode = pc_not then begin
      op^.left := op^.left^.left;
      op^.opcode := newOpcode;
      PeepHoleOptimization(opv);
      end {else if}
   else if topcode in [pc_neq,pc_equ] then begin
      with op^.left^.right^ do
         if opcode = pc_ldc then
            if optype in [cgByte,cgUByte,cgWord,cgUWord] then
               if q = 0 then begin
                  op^.left := op^.left^.left;
                  if topcode = pc_equ then
                     op^.opcode := newOpcode;
                  end; {if}
      end; {else if}
   if op^.next^.opcode = dc_lab then
      if op^.next^.q = op^.q then
         if not SideEffects(op^.left) then begin
            rescan := true;
            opv := op^.next;
            end; {else if}
   end; {JumpOptimizations}


   procedure RealStoreOptimizations (op, opl: icptr);

   { do strength reductions associated with stores of reals	}
   {								}
   { parameters:						}
   {    op - real store to optimize				}
   {    opl - load operand for the store operation		}

   var
      disp: 0..9;			{disp to the word to change}
      same: boolean;			{are the operands the same?}
      op2: icptr;			{new opcode}
      opt: icptr;			{temp opcode}

      cnvrl: record			{for stuffing a real in a long space}
	 case boolean of
            true:  (lval: longint);
            false: (rval: real);
	 end;

   begin {RealStoreOptimizations}
   if opl^.opcode = pc_cnv then
      if baseTypeEnum(opl^.q & $000F) = op^.optype then
         opl^.q := (opl^.q & $FFF0) | ord(cgExtended);
   if (op^.optype = cgComp) or not (op^.opcode in [pc_sro,pc_str,pc_sto]) then
      {skip below optimizations}
   else if opl^.opcode = pc_ngr then begin
      same := false;
      with opl^.left^ do
         if op^.opcode = pc_sro then begin
            if opcode = pc_ldo then
               if q = op^.q then
                  if optype = op^.optype then
                     if lab^ = op^.lab^ then
                        same := true;
            end {if}
         else {if op^.opcode = pc_str then}
            if opcode = pc_lod then
               if q = op^.q then
                  if r = op^.r then
                     if optype = op^.optype then
                        same := true;
      if same then begin
         case op^.optype of
            cgReal: disp := 2;
            cgDouble: disp := 6;
            cgExtended: disp := 8;
            end; {case}
         opl^.left^.optype := cgWord;
         opl^.left^.q := opl^.left^.q + disp;
         op^.optype := cgWord;
         op^.q := op^.q + disp;
         op2 := pointer(Calloc(sizeof(intermediate_code)));
         op2^.opcode := pc_ldc;
         op2^.optype := cgWord;
         op2^.q := $8000;
         opl^.right := op2;
         opl^.opcode := pc_bxr;
         end {if}
      else if op^.optype = cgReal then begin
         opt := opl^.left;
         if opt^.opcode in [pc_ind,pc_ldo,pc_lod] then
            if opt^.optype = cgReal then begin
               opt^.optype := cgLong;
               op^.optype := cgLong;
               op2 := pointer(Calloc(sizeof(intermediate_code)));
               op2^.opcode := pc_ldc;
               op2^.optype := cgLong;
               op2^.lval := $80000000;
	       opl^.right := op2;
               opl^.opcode := pc_blx;
               end; {if}
         end; {else if}
      end {if}
   else if op^.optype = cgReal then begin
      if opl^.opcode = pc_ldc then begin
         cnvrl.rval := opl^.rval;
         opl^.lval := cnvrl.lval;
         opl^.optype := cgLong;
         op^.optype := cgLong;
         end {if}
      else if opl^.opcode in [pc_ind,pc_ldo,pc_lod] then
         if opl^.optype = cgReal then begin
            opl^.optype := cgLong;
            op^.optype := cgLong;
            end; {if}
      end; {if}
   end; {RealStoreOptimizations}


   procedure ReplaceLoads (ldop, stop, tree: icptr);

   { Replace any pc_lod operations in tree that load from the	}
   { location stored to by the pc_str operation stop by ldop	}
   {								}
   { parameters:						}
   {    ldop - operation to replace the pc_lods with		}
   {    stop - pc_str operation					}
   {    tree - tree to check for pc_lod operations		}
   {								}
   { Notes: ldop must be an instruction, not a tree		}

   begin {ReplaceLoads}
   if tree^.left <> nil then
      ReplaceLoads(ldop, stop, tree^.left);
   if tree^.right <> nil then
      ReplaceLoads(ldop, stop, tree^.right);
   if tree^.opcode = pc_lod then
      if tree^.optype = stop^.optype then
         if tree^.q = stop^.q then
            if tree^.r = stop^.r then
               tree^ := ldop^;
   end; {ReplaceLoads}


   procedure ReverseChildren (op: icptr);

   { reverse the children of a node				}
   {								}
   { parameters:						}
   {    op - node for which to reverse the children		}

   var
      opt: icptr;			{temp opcode pointer}

   begin {ReverseChildren}
   opt := op^.right;
   op^.right := op^.left;
   op^.left := opt;
   end; {ReverseChildren}


   procedure ZeroIntermediateCode (op: icptr);

   { Set all fields in the record to 0, nil, etc.		}
   {								}
   { Parameters:						}
   {    op - intermediate code record to clear			}

   begin {ZeroIntermediateCode}
   op^.q := 0;
   op^.r := 0;
   op^.s := 0;
   op^.lab := nil;
   op^.next := nil;
   op^.left := nil;
   op^.right := nil;
   op^.optype := cgWord;
   op^.opnd := 0;
   op^.llab := 0;
   op^.slab := 0;
   end; {ZeroIntermediateCode}


begin {PeepHoleOptimization}
{if printSymbols then begin write('Optimize: '); WriteCode(opv); end; {debug}
op := opv;				{copy for efficiency}
if op^.left <> nil then			{optimize the children}
   PeepHoleOptimization(op^.left);
if op^.right <> nil then
   PeepHoleOptimization(op^.right);
case op^.opcode of			{check for optimizations of this node}
   pc_add: begin			{pc_add}
      if op^.next^.opcode <> pc_add then
         RemoveDeadCode(op);
      end; {case pc_add}

   pc_adi: begin			{pc_adi}
      if (op^.right^.opcode = pc_ldc) and (op^.left^.opcode = pc_ldc) then begin
         op^.left^.q := op^.left^.q + op^.right^.q;
         opv := op^.left;
         end {if}
      else begin
         if op^.left^.opcode = pc_ldc then
            ReverseChildren(op);
         if op^.right^.opcode = pc_ldc then begin
            q := op^.right^.q;
            if q = 0 then
               opv := op^.left
            else if q > 0 then begin
               op^.opcode := pc_inc;
               op^.q := q;
               op^.right := nil;
               end {else if}
            else {if q < 0 then} begin
               op^.opcode := pc_dec;
               op^.q := -q;
               op^.right := nil;
               end; {else if}
            end {if}
         else if CodesMatch(op^.left, op^.right, false) then begin
            if not SideEffects(op^.left) then begin
               ZeroIntermediateCode(op^.right);
               with op^.right^ do begin
                  opcode := pc_ldc;
                  q := 1;
                  optype := cgWord;
                  end; {with}
               op^.opcode := pc_shl;
               PeepHoleOptimization(opv);
               end; {if}
            end {else if}
         else if op^.left^.opcode in [pc_inc,pc_dec] then begin
            if op^.right^.opcode in [pc_inc,pc_dec] then begin
               op2 := op^.left;
               if op2^.opcode = pc_inc then
                  q := op2^.q
               else
                  q := -op2^.q;
               if op^.right^.opcode = pc_inc then
                  q := q + op^.right^.q
               else
                  q := q - op^.right^.q;
               if q >= 0 then begin
                  op2^.opcode := pc_inc;
                  op2^.q := q;
                  end {if}
               else begin
                  op2^.opcode := pc_dec;
                  op2^.q := -q;
                  end; {else}
               op^.left := op^.left^.left;
               op^.right := op^.right^.left;
               op2^.left := op;
               opv := op2;
               PeepHoleOptimization(opv);
               end; {if}
            end; {else if}
         end; {else}
      end; {case pc_adi}

   pc_adl: begin			{pc_adl}
      if (op^.right^.opcode = pc_ldc) and (op^.left^.opcode = pc_ldc) then begin
         op^.left^.lval := op^.left^.lval + op^.right^.lval;
         opv := op^.left;
         end {if}
      else begin
         done := false;
         if op^.left^.opcode = pc_ldc then
            ReverseChildren(op);
         if op^.right^.opcode = pc_ldc then begin
            lval := op^.right^.lval;
            if lval = 0 then begin
               opv := op^.left;
               done := true;
               end {if}
            else if (lval >= 0) and (lval <= maxint) then begin
               op^.opcode := pc_inc;
               op^.optype := cgLong;
               op^.q := ord(lval);
               op^.right := nil;
               done := true;
               end {else if}
            else if (lval > -maxint) and (lval < 0) then begin
               op^.opcode := pc_dec;
               op^.optype := cgLong;
               op^.q := -ord(lval); 
               op^.right := nil;
               done := true;
               end; {else if}
            end {if}
         else if CodesMatch(op^.left, op^.right, false) then
            if not SideEffects(op^.left) then begin
               ZeroIntermediateCode(op^.right);
               with op^.right^ do begin
                  opcode := pc_ldc;
                  lval := 1;
                  optype := cgLong;
                  end; {with}
               op^.opcode := pc_sll;
               done := true;
               end; {if}
         if not done and (op^.right^.opcode in [pc_lao,pc_lda,pc_ixa]) then
            ReverseChildren(op);
         if not done and (op^.left^.opcode in [pc_lao,pc_lda,pc_ixa]) then
            if op^.right^.opcode = pc_sll then begin
               if op^.right^.right^.opcode = pc_ldc then
                  if (op^.right^.right^.lval & $FFFF8000) = 0 then
                     if op^.right^.left^.opcode = pc_cnv then begin
                	fromtype.i := (op^.right^.left^.q & $00F0) >> 4;
                	if fromType.optype in [cgByte,cgUByte,cgWord,cgUWord] then
                           if op^.left^.opcode = pc_lda then
                              begin
                              if fromType.optype = cgByte then
                                 op^.right^.left^.q := $02
                              else if fromType.optype = cgUByte then
                                 op^.right^.left^.q := $13
                              else
                                 op^.right^.left := op^.right^.left^.left;
                              with op^.right^.right^ do begin
                                 lq := lval;
                                 lval := 0;
                                 q := long(lq).lsw;
                                 optype := cgUWord;
                                 end; {with}
                              op^.right^.opcode := pc_shl;
                              op^.opcode := pc_ixa;
                              if fromType.optype in [cgByte,cgWord] then
                                 op^.optype := cgWord
                              else
                                 op^.optype := cgUWord;
                              PeepHoleOptimization(opv);
                              end; {if}
                	end; {if}
               end {if}
            else if op^.right^.opcode = pc_cnv then begin
               fromtype.i := (op^.right^.q & $00F0) >> 4;
               if fromtype.optype in [cgByte,cgUByte,cgWord,cgUWord] then begin
                  if fromType.optype = cgByte then
                     op^.right^.q := $02
                  else if fromType.optype = cgUByte then
                     op^.right^.q := $13
                  else
                     op^.right := op^.right^.left;
                  op^.opcode := pc_ixa;
                  if fromType.optype in [cgByte,cgWord] then
                     op^.optype := cgWord
                  else
                     op^.optype := cgUWord;
                  PeepHoleOptimization(opv);
                  end; {if}
               end; {else if}
         end; {else}
      end; {case pc_adl}

   pc_adr: begin			{pc_adr}
      if (op^.right^.opcode = pc_ldc) and (op^.left^.opcode = pc_ldc) then begin
         op^.left^.rval := op^.left^.rval + op^.right^.rval;
         opv := op^.left;
         end {if}
      else begin
         if op^.left^.opcode = pc_ldc then
            ReverseChildren(op);
         if op^.right^.opcode = pc_ldc then begin
            if fastMath then
               if op^.right^.rval = 0.0 then
                  opv := op^.left;
            end; {if}
         end; {else}   
      end; {case pc_adr}

   pc_adq: begin			{pc_adq}
      if (op^.right^.opcode = pc_ldc) and (op^.left^.opcode = pc_ldc) then begin
         add64(op^.left^.qval, op^.right^.qval);
         opv := op^.left;
         end {if}
      else begin
         if op^.left^.opcode = pc_ldc then
            ReverseChildren(op);
         if op^.right^.opcode = pc_ldc then begin
            if (op^.right^.qval.lo = 0) and (op^.right^.qval.hi = 0) then
               opv := op^.left;
            end; {if}
         end; {else}
      end; {case pc_adq}

   pc_and: begin			{pc_and}
      if op^.right^.opcode = pc_ldc then begin
         if op^.left^.opcode = pc_ldc then begin
            op^.left^.q := ord((op^.left^.q <> 0) and (op^.right^.q <> 0));
            opv := op^.left;
            end {if}
         else begin
            if op^.right^.q = 0 then 
               if not SideEffects(op^.left) then 
                  opv := op^.right;
            end {else}
         end {if}
      else if op^.left^.opcode = pc_ldc then
         if op^.left^.q = 0 then
            opv := op^.left;
      end; {case pc_and}

   pc_bal: begin			{pc_bal}
      if op^.left^.opcode = pc_ldc then
         ReverseChildren(op);
      if op^.left^.opcode = pc_ldc then begin
         op^.left^.lval := op^.left^.lval & op^.right^.lval;
         opv := op^.left;
         end {if}
      else if op^.right^.opcode = pc_ldc then begin
         if op^.right^.lval = 0 then begin
            if not SideEffects(op^.left) then
               opv := op^.right;
            end {if}
         else if op^.right^.lval = -1 then
            opv := op^.left;
         end; {else if}
      end; {case pc_bal}

   pc_baq: begin			{pc_baq}
      if op^.left^.opcode = pc_ldc then
         ReverseChildren(op);
      if op^.left^.opcode = pc_ldc then begin
         op^.left^.qval.hi := op^.left^.qval.hi & op^.right^.qval.hi;
         op^.left^.qval.lo := op^.left^.qval.lo & op^.right^.qval.lo;
         opv := op^.left;
         end {if}
      else if op^.right^.opcode = pc_ldc then begin
         if (op^.right^.qval.lo = 0) and (op^.right^.qval.hi = 0) then begin
            if not SideEffects(op^.left) then
               opv := op^.right;
            end {if}
         else if (op^.right^.qval.lo = -1) and (op^.right^.qval.hi = -1) then
            opv := op^.left;
         end; {else if}
      end; {case pc_baq}

   pc_blr: begin			{pc_blr}
      if op^.left^.opcode = pc_ldc then
         ReverseChildren(op);
      if op^.left^.opcode = pc_ldc then begin
         op^.left^.lval := op^.left^.lval | op^.right^.lval;
         opv := op^.left;
         end {if}
      else if op^.right^.opcode = pc_ldc then begin
         if op^.right^.lval = -1 then begin
            if not SideEffects(op^.left) then
               opv := op^.right;
            end {if}
         else if op^.right^.lval = 0 then
            opv := op^.left;
         end; {else if}
      end; {case pc_blr}

   pc_bqr: begin			{pc_bqr}
      if op^.left^.opcode = pc_ldc then
         ReverseChildren(op);
      if op^.left^.opcode = pc_ldc then begin
         op^.left^.qval.hi := op^.left^.qval.hi | op^.right^.qval.hi;
         op^.left^.qval.lo := op^.left^.qval.lo | op^.right^.qval.lo;
         opv := op^.left;
         end {if}
      else if op^.right^.opcode = pc_ldc then begin
         if (op^.right^.qval.hi = -1) and (op^.right^.qval.lo = -1) then begin
            if not SideEffects(op^.left) then
               opv := op^.right;
            end {if}
         else if (op^.right^.qval.hi = 0) and (op^.right^.qval.lo = 0) then
            opv := op^.left;
         end; {else if}
      end; {case pc_bqr}

   pc_blx: begin			{pc_blx}
      if op^.left^.opcode = pc_ldc then
         ReverseChildren(op);
      if op^.left^.opcode = pc_ldc then begin
         op^.left^.lval := op^.left^.lval ! op^.right^.lval;
         opv := op^.left;
         end {if}
      else if op^.right^.opcode = pc_ldc then begin
         if op^.right^.lval = 0 then
            opv := op^.left
         else if op^.right^.lval = -1 then begin
            op^.opcode := pc_bnl;
            op^.right := nil;
            end; {else if}
         end; {else if}
      end; {case pc_blx}

   pc_bqx: begin			{pc_bqx}
      if op^.left^.opcode = pc_ldc then
         ReverseChildren(op);
      if op^.left^.opcode = pc_ldc then begin
         op^.left^.qval.hi := op^.left^.qval.hi ! op^.right^.qval.hi;
         op^.left^.qval.lo := op^.left^.qval.lo ! op^.right^.qval.lo;
         opv := op^.left;
         end {if}
      else if op^.right^.opcode = pc_ldc then begin
         if (op^.right^.qval.lo = 0) and (op^.right^.qval.hi = 0) then
            opv := op^.left
         else if (op^.right^.qval.lo = -1) and (op^.right^.qval.hi = -1) then begin
            op^.opcode := pc_bnq;
            op^.right := nil;
            end; {else if}
         end; {else if}
      end; {case pc_bqx}

   pc_bnd: begin			{pc_bnd}
      if op^.left^.opcode = pc_ldc then
         ReverseChildren(op);
      if op^.left^.opcode = pc_ldc then begin
         op^.left^.q := op^.left^.q & op^.right^.q;
         opv := op^.left;
         end {if}
      else if op^.right^.opcode = pc_ldc then begin
         if op^.right^.q = 0 then begin
            if not SideEffects(op^.left) then
               opv := op^.right;
            end {if}
         else if op^.right^.q = -1 then
            opv := op^.left;
         end; {else if}
      end; {case pc_bnd}

   pc_bnl: begin			{pc_bnl}
      if op^.left^.opcode = pc_ldc then begin
         op^.left^.lval := op^.left^.lval ! $FFFFFFFF;
         opv := op^.left;
         end; {if}
      end; {case pc_bnl}

   pc_bnq: begin			{pc_bnq}
      if op^.left^.opcode = pc_ldc then begin
         op^.left^.qval.hi := op^.left^.qval.hi ! $FFFFFFFF;
         op^.left^.qval.lo := op^.left^.qval.lo ! $FFFFFFFF;
         opv := op^.left;
         end; {if}
      end; {case pc_bnq}

   pc_bno: begin			{pc_bno}
      {Invalid optimization disabled}
      {if op^.left^.opcode = pc_str then
         if op^.left^.left^.opcode in [pc_lda,pc_lao] then begin
            ReplaceLoads(op^.left^.left, op^.left, op^.right);
            opv := op^.right;
            end;} {if}
      end; {case pc_bno}

   pc_bnt: begin			{pc_bnt}
      if op^.left^.opcode = pc_ldc then begin
         op^.left^.q := op^.left^.q ! $FFFF;
         opv := op^.left;
         end; {if}
      end; {case pc_bnt}

   pc_bor: begin			{pc_bor}
      if op^.left^.opcode = pc_ldc then
         ReverseChildren(op);
      if op^.left^.opcode = pc_ldc then begin
         op^.left^.q := op^.left^.q | op^.right^.q;
         opv := op^.left;
         end {if}
      else if op^.right^.opcode = pc_ldc then begin
         if op^.right^.q = -1 then begin
            if not SideEffects(op^.left) then
               opv := op^.right;
            end {if}
         else if op^.right^.q = 0 then
            opv := op^.left;
         end {else if}
      else if ((op^.left^.opcode = pc_shl) and (op^.right^.opcode = pc_usr))
         or ((op^.left^.opcode = pc_usr) and (op^.right^.opcode = pc_shl)) then
         if op^.left^.right^.opcode = pc_ldc then
            if op^.right^.right^.opcode = pc_ldc then
               if op^.left^.right^.q = 8 then
                  if op^.right^.right^.q = 8 then
                     if CodesMatch(op^.left^.left, op^.right^.left, false) then
                        if not SideEffects(op^.left^.left) then begin
                           op^.opcode := pc_rbo;
                           op^.left := op^.left^.left;
                           op^.right := nil;
                           end; {if}
         
      end; {case pc_bor}

   pc_bxr: begin			{pc_bxr}
      if op^.left^.opcode = pc_ldc then
         ReverseChildren(op);
      if op^.left^.opcode = pc_ldc then begin
         op^.left^.q := op^.left^.q ! op^.right^.q;
         opv := op^.left;
         end {if}
      else if op^.right^.opcode = pc_ldc then begin
         if op^.right^.q = 0 then
            opv := op^.left
         else if op^.right^.q = -1 then begin
            op^.opcode := pc_bnt;
            op^.right := nil;
            end; {else if}
         end; {else if}
      end; {case pc_bxr}

   pc_cnv: begin			{pc_cnv}
      fromtype.i := (op^.q & $00F0) >> 4;
      totype.i := op^.q & $000F;
      if (fromtype.optype = cgWord) and (TypeOf(op^.left) = cgUByte) then begin
         fromType.optype := cgUWord;
         op^.q := (op^.q & $FF0F) | (fromtype.i << 4);
         end; {if}
      if op^.left^.opcode = pc_ldc then begin
         doit := true;
	 case fromtype.optype of
            cgByte,cgWord:
               case totype.optype of
        	  cgByte,cgUByte,cgWord,cgUWord: ;
        	  cgLong,cgULong: begin
                     lval := op^.left^.q;
                     op^.left^.q := 0;
                     op^.left^.lval := lval;
                     end;
        	  cgQuad,cgUQuad: begin
                     op^.left^.qval.lo := op^.left^.q;
                     if op^.left^.qval.lo < 0 then
                        op^.left^.qval.hi := -1
                     else
                        op^.left^.qval.hi := 0;
                     op^.left^.q := 0;
                     end;
        	  cgReal,cgDouble,cgComp,cgExtended: begin
                     rval := op^.left^.q;
                     LimitPrecision(rval, totype.optype);
                     op^.left^.q := 0;
                     op^.left^.rval := rval;
                     end;
                  otherwise: ;
        	  end; {case}                             
            cgUByte,cgUWord:
               case totype.optype of
        	  cgByte,cgUByte,cgWord,cgUWord: ;
        	  cgLong,cgULong: begin
                     lval := ord4(op^.left^.q) & $0000FFFF;
                     op^.left^.q := 0;
                     op^.left^.lval := lval;
                     end;
        	  cgQuad,cgUQuad: begin
                     op^.left^.qval.lo := ord4(op^.left^.q) & $0000FFFF;
                     op^.left^.qval.hi := 0;
                     op^.left^.q := 0;
                     end;
        	  cgReal,cgDouble,cgComp,cgExtended: begin
                     rval := ord4(op^.left^.q) & $0000FFFF;
                     LimitPrecision(rval, totype.optype);
                     op^.left^.q := 0;
                     op^.left^.rval := rval;
                     end;
                  otherwise: ;
        	  end; {case}                             
            cgLong:
               case totype.optype of
        	  cgByte,cgUByte,cgWord,cgUWord: begin
                     q := long(op^.left^.lval).lsw;                
                     op^.left^.lval := 0;
                     op^.left^.q := q;
                     end;
        	  cgLong, cgULong: ;
        	  cgQuad,cgUQuad: begin
                     op^.left^.qval.lo := op^.left^.lval;
                     if op^.left^.qval.lo < 0 then
                        op^.left^.qval.hi := -1
                     else
                        op^.left^.qval.hi := 0;
                     end;
        	  cgReal,cgDouble,cgComp,cgExtended: begin
                     rval := op^.left^.lval;
                     LimitPrecision(rval, totype.optype);
                     op^.left^.lval := 0;
                     op^.left^.rval := rval;
                     end;
                  otherwise: ;
        	  end; {case}
            cgULong:
               case totype.optype of
        	  cgByte,cgUByte,cgWord,cgUWord: begin
                     q := long(op^.left^.lval).lsw;
                     op^.left^.lval := 0;
                     op^.left^.q := q;
                     end;
        	  cgLong, cgULong: ;
        	  cgQuad,cgUQuad: begin
                     op^.left^.qval.lo := op^.left^.lval;
                     op^.left^.qval.hi := 0;
                     end;
        	  cgReal,cgDouble,cgComp,cgExtended: begin
                     lval := op^.left^.lval;
                     op^.left^.lval := 0;
                     if lval >= 0 then
                        rval := lval
                     else
                        rval := (lval & $7FFFFFFF) + 2147483648.0;
                     LimitPrecision(rval, totype.optype);
                     op^.left^.rval := rval;
                     end;
                  otherwise: ;
        	  end; {case}
            cgQuad:
               case totype.optype of
                  cgByte,cgUByte,cgWord,cgUWord: begin
                     q := long(op^.left^.qval.lo).lsw;
                     op^.left^.qval := longlong0;
                     op^.left^.q := q;
                     end;
                  cgLong, cgULong: begin
                     lval := op^.left^.qval.lo;
                     op^.left^.qval := longlong0;
                     op^.left^.lval := lval;
                     end;
                  cgQuad,cgUQuad: ;
                  cgDouble,cgExtended: begin
                     rval := CnvLLX(op^.left^.qval);
                     LimitPrecision(rval, totype.optype);
                     op^.left^.qval := longlong0;
                     op^.left^.rval := rval;
                     end;
                  cgReal,cgComp:
                     doit := false;
                  otherwise: ;
                  end; {case}
            cgUQuad:
               case totype.optype of
                  cgByte,cgUByte,cgWord,cgUWord: begin
                     q := long(op^.left^.qval.lo).lsw;
                     op^.left^.qval := longlong0;
                     op^.left^.q := q;
                     end;
                  cgLong, cgULong: begin
                     lval := op^.left^.qval.lo;
                     op^.left^.qval := longlong0;
                     op^.left^.lval := lval;
                     end;
                  cgQuad,cgUQuad: ;
                  cgDouble,cgExtended: begin
                     rval := CnvULLX(op^.left^.qval);
                     LimitPrecision(rval, totype.optype);
                     op^.left^.qval := longlong0;
                     op^.left^.rval := rval;
                     end;
                  cgReal,cgComp:
                     doit := false;
                  otherwise: ;
                  end; {case}
            cgReal,cgDouble,cgComp,cgExtended: begin
               rval := op^.left^.rval;
               case totype.optype of
        	  cgByte: begin
                     if rval < -128.0 then
                        q := -128
                     else if rval > 127.0 then
                        q := 127
                     else
                        q := trunc(rval);
                     op^.left^.rval := 0.0;
                     op^.left^.q := q;
                     end;
        	  cgUByte: begin
                     if rval < 0.0 then
                        q := 0
                     else if rval > 255.0 then
                        q := 255
                     else
                        q := trunc(rval);
                     op^.left^.rval := 0.0;
                     op^.left^.q := q;
                     end;
        	  cgWord: begin
                     if rval < -32768.0 then
                        lval := -32768
                     else if rval > 32767.0 then
                        lval := 32767
                     else
                        lval := trunc(rval);
                     op^.left^.rval := 0.0;
                     op^.left^.q := long(lval).lsw;
                     end;
        	  cgUWord: begin
                     if rval < 0.0 then
                        lval := 0
                     else if rval > 65535.0 then
                        lval := 65535
                     else
                        lval := trunc4(rval);
                     op^.left^.rval := 0.0;
                     op^.left^.q := long(lval).lsw;
                     end;
        	  cgLong: begin
                     if rval < -2147483648.0 then
                        lval := $80000000
                     else if rval > 2147483647.0 then
                        lval := 2147483647
                     else
                        lval := trunc4(rval);
                     op^.left^.rval := 0.0;
                     op^.left^.lval := lval;
                     end;
        	  cgULong: begin
                     if rval < 0.0 then
                        lval := 0
                     else if rval >= 4294967295.0 then
                        lval := $FFFFFFFF
                     else if rval > 2147483647.0 then begin
                        rval := rval - 2147483647.0;
                        lval := 2147483647 + trunc4(rval);
                        end {else if}
                     else
                        lval := trunc4(rval);
                     op^.left^.rval := 0.0;
                     op^.left^.lval := lval;
                     end;
                  cgQuad:
                     CnvXLL(op^.left^.qval, rval);
                  cgUQuad:
                     CnvXULL(op^.left^.qval, rval);
        	  cgReal,cgDouble,cgComp,cgExtended:
        	     LimitPrecision(rval, totype.optype);
                  otherwise: ;
                  end;
               end; {case}        
            otherwise: ;
            end; {case}
         if doit then
            if fromtype.optype in
               [cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong,cgQuad,cgUQuad,
               cgReal,cgDouble,cgComp,cgExtended] then
               if totype.optype in
                  [cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong,cgQuad,cgUQuad,
                  cgReal,cgDouble,cgComp,cgExtended] then begin
                  op^.left^.optype := totype.optype;
                  if totype.optype in [cgByte,cgUByte] then begin
                     op^.left^.q := op^.left^.q & $00FF;
                     if totype.optype = cgByte then
                        if (op^.left^.q & $0080) <> 0 then
                           op^.left^.q := op^.left^.q | $FF00;
                     end; {if}
                  opv := op^.left;
                  end; {if}
         end {if}
      else if op^.left^.opcode = pc_cnv then begin
         doit := false;
         firsttype.i := (op^.left^.q & $00F0) >> 4;
         if fromType.optype in [cgReal,cgDouble,cgComp,cgExtended] then begin
            if toType.optype in [cgReal,cgDouble,cgComp,cgExtended] then
               if (baseTypeEnum(op^.left^.q & $000F) = toType.optype)
                  or (baseTypeEnum(op^.left^.q & $000F) = cgExtended) then
                  doit := true;
            end {if}
         else begin
            if firstType.optype in [cgByte,cgWord,cgLong] then
               if fromType.optype in [cgByte,cgWord,cgLong] then
                  if toType.optype in [cgByte,cgWord,cgLong] then
                     doit := true;
            if firstType.optype in [cgUByte,cgUWord,cgULong] then
               if fromType.optype in [cgUByte,cgUWord,cgULong] then
                  if toType.optype in [cgUByte,cgUWord,cgLong] then
                     doit := true;
            if TypeSize(firstType.optype) = TypeSize(fromType.optype) then
               if TypeSize(firstType.optype) = TypeSize(toType.optype) then
                  doit := true;
            if TypeSize(fromType.optype) < TypeSize(firstType.optype) then
               if TypeSize(fromType.optype) < TypeSize(toType.optype) then
                  doit := false;        {disable optimization in invalid cases}
            end; {else}
         if doit then begin
            op^.q := (op^.left^.q & $00F0) | (op^.q & $000F);
            op^.left := op^.left^.left;
            PeepHoleOptimization(opv);
            end; {if}
         end {else if}
      else if (op^.left^.opcode in [pc_lod,pc_ldo]) or
         ((op^.left^.opcode = pc_ind) and (op^.left^.r = 0)) then begin
         if fromtype.optype in [cgWord,cgUWord] then
            if totype.optype in [cgByte,cgUByte,cgWord,cgUWord] then begin
               op^.left^.optype := totype.optype;
               opv := op^.left;
               end; {if}
         if fromtype.optype in [cgLong,cgULong] then
            if totype.optype in [cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong]
               then begin
               op^.left^.optype := totype.optype;
               opv := op^.left;
               end; {if}
         if fromtype.optype in [cgQuad,cgUQuad] then
            if totype.optype in
               [cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong,cgQuad,cgUQuad]
               then begin
               op^.left^.optype := totype.optype;
               opv := op^.left;
               end; {if}
         if fromtype.optype in [cgReal,cgDouble,cgExtended,cgComp] then
            if totype.optype in [cgReal,cgDouble,cgExtended,cgComp] then
               if (totype.optype = op^.left^.optype) or
                  (totype.optype = cgExtended) or
                  ((totype.optype = cgDouble) and (op^.left^.optype = cgReal)) then
                  opv := op^.left;
         end {else if}
      else if op^.q in [$40,$41,$50,$51] then begin
         {any long type to byte type}
         with op^.left^ do
            if opcode = pc_bal then
               if right^.opcode = pc_ldc then
                  if right^.lval = 255 then begin
                     op^.left := op^.left^.left;
                     PeepHoleOptimization(opv);
                     end; {if}
         with op^.left^ do    
            if opcode in [pc_slr,pc_vsr] then
               if right^.opcode = pc_ldc then
                  if (left^.opcode in [pc_lod,pc_ldo]) or
                     ((left^.opcode = pc_ind) and (left^.r = 0)) then begin
                     lq := right^.lval;
                     if long(lq).msw = 0 then
                        if long(lq).lsw in [8,16,24] then begin
                           lq := lq div 8;
                           left^.q := left^.q + long(lq).lsw;
                           op^.left := left;
                	   PeepHoleOptimization(opv);
                	   end; {if}
                     end; {if}
         end; {else if}                     
      end; {case pc_cnv}

   pc_cop,pc_cpo: begin			{pc_cop,pc_cpo}
      if op^.optype in [cgReal,cgDouble,cgExtended,cgComp] then
         RealStoreOptimizations(op, op^.left);
      end; {case pc_cop,pc_cpo}

   pc_cpi: begin			{pc_cpi}
      if op^.optype in [cgReal,cgDouble,cgExtended,cgComp] then
         RealStoreOptimizations(op, op^.right);
      end; {case pc_cpi}

   pc_dec: begin			{pc_dec}
      if op^.q = 0 then
         opv := op^.left
      else begin
	 opcode := op^.left^.opcode;
	 if opcode = pc_dec then begin
            if ord4(op^.left^.q) + ord4(op^.q) < ord4(maxint) then begin
               op^.q := op^.q + op^.left^.q;
               op^.left := op^.left^.left;
               end; {if}
            end {if}
	 else if opcode = pc_inc then begin
            q := op^.q - op^.left^.q;
            if q < 0 then begin
               q := -q;
               op^.opcode := pc_inc;
               end; {if}
            op^.q := q;
            op^.left := op^.left^.left;
            PeepHoleOptimization(opv);
            end {else if}
         else if opcode = pc_ldc then begin
            if op^.optype in [cgLong, cgULong] then begin
               op^.left^.lval := op^.left^.lval - op^.q;
               opv := op^.left;
               end {if}
            else if op^.optype in [cgUByte, cgByte, cgUWord, cgWord] then begin
               op^.left^.q := op^.left^.q - op^.q;
               opv := op^.left;
               end; {else if}
            end; {else if}
         end; {else}
      end; {case pc_dec}

   pc_dvi: begin			{pc_dvi}
      if op^.right^.opcode = pc_ldc then begin
         if op^.left^.opcode = pc_ldc then begin
            if op^.right^.q <> 0 then begin
               op^.left^.q := op^.left^.q div op^.right^.q;
               opv := op^.left;
               end; {if}
            end {if}
         else if op^.right^.q = 1 then
            opv := op^.left;
         end; {if}
      end; {case pc_dvi}

   pc_dvl: begin			{pc_dvl}
      if op^.right^.opcode = pc_ldc then begin
         if op^.left^.opcode = pc_ldc then begin
            if op^.right^.lval <> 0 then begin
               op^.left^.lval := op^.left^.lval div op^.right^.lval;
               opv := op^.left;
               end; {if}
            end {if}
         else if op^.right^.lval = 1 then
            opv := op^.left;
         end; {if}
      end; {case pc_dvl}

   pc_dvq: begin			{pc_dvq}
      if op^.right^.opcode = pc_ldc then begin
         if op^.left^.opcode = pc_ldc then begin
            if (op^.right^.qval.lo <> 0) or (op^.right^.qval.hi <> 0) then begin
               div64(op^.left^.qval, op^.right^.qval);
               opv := op^.left;
               end; {if}
            end {if}
         else if (op^.right^.qval.lo = 1) and (op^.right^.qval.hi = 0) then
            opv := op^.left;
         end; {if}
      end; {case pc_dvq}

   pc_dvr: begin			{pc_dvr}
      if op^.right^.opcode = pc_ldc then begin
         if op^.left^.opcode = pc_ldc then begin
            if op^.right^.rval <> 0.0 then begin
               op^.left^.rval := op^.left^.rval/op^.right^.rval;
               opv := op^.left;
               end; {if}
            end {if}
         else if op^.right^.rval = 1.0 then
            opv := op^.left;
         end; {if}
      end; {case pc_dvr}

   pc_equ: begin			{pc_equ}
      if op^.left^.opcode = pc_ldc then
         ReverseChildren(op);
      if op^.right^.opcode = pc_ldc then begin
	 if op^.left^.opcode = pc_ldc then begin
            BinOps(op^.left, op^.right);
            case op^.left^.optype of
               cgByte,cgUByte,cgWord,cgUWord: begin
        	  op^.opcode := pc_ldc;
        	  op^.q := ord(op^.left^.q = op^.right^.q);
        	  op^.left := nil;
        	  op^.right := nil;
        	  end;
               cgLong,cgULong: begin
        	  op^.opcode := pc_ldc;
        	  op^.q := ord(op^.left^.lval = op^.right^.lval);
        	  op^.left := nil;
        	  op^.right := nil;
        	  end;
               cgQuad,cgUQuad: begin
        	  op^.opcode := pc_ldc;
        	  op^.q := ord((op^.left^.qval.lo = op^.right^.qval.lo) and
        	               (op^.left^.qval.hi = op^.right^.qval.hi));
        	  op^.left := nil;
        	  op^.right := nil;
        	  end;
               cgReal,cgDouble,cgComp,cgExtended: begin
        	  op^.opcode := pc_ldc;
        	  op^.q := ord(op^.left^.rval = op^.right^.rval);
        	  op^.left := nil;
        	  op^.right := nil;
        	  end;
               cgVoid,ccPointer: begin
        	  op^.opcode := pc_ldc;
        	  op^.q := ord(op^.left^.pval = op^.right^.pval);
        	  op^.left := nil;
        	  op^.right := nil;
        	  end;
               end; {case}
            op^.optype := cgWord;
            end {if}
         else if op^.right^.optype in [cgByte, cgUByte, cgWord, cgUWord] then begin
            if op^.right^.q = 1 then
               if op^.left^.opcode in
         	  [pc_and,pc_ior,pc_neq,pc_equ,pc_geq,pc_leq,pc_les,pc_grt,pc_not]
                  then begin
                  opv := op^.left;
                  opv^.next := op^.next;
                  end; {if}
            end {else if}
         else if op^.right^.optype in [cgLong, cgULong] then begin
            if op^.right^.lval = 1 then
               if op^.left^.opcode in
         	  [pc_and,pc_ior,pc_neq,pc_equ,pc_geq,pc_leq,pc_les,pc_grt,pc_not]
                  then begin
                  opv := op^.left;
                  opv^.next := op^.next;
                  end; {if}
            end; {else if}
         end; {if}                      
      end; {case pc_equ}

   pc_fjp: begin			{pc_fjp}
      opcode := op^.left^.opcode;
      if opcode = pc_ldc then begin
         if op^.left^.optype in [cgByte, cgUByte, cgWord, cgUWord] then begin
            if op^.left^.q <> 0 then begin
               opv := op^.next;
               rescan := true;
               end {if}
            else begin
               op^.opcode := pc_ujp;
               op^.left := nil;
               PeepHoleOptimization(opv);
               end; {else}
            end {if}
         end {if}
      else if opcode = pc_and then begin
         op2 := op^.left;
         op2^.next := op^.next;
         op^.next := op2;
         op^.left := op2^.left;
         op2^.left := op2^.right;
         op2^.right := nil;
         op2^.opcode := pc_fjp;
         op2^.q := op^.q;
         PeepHoleOptimization(opv);
         end {else if}
      else if opcode = pc_ior then begin
         op2 := op^.left;
         op2^.next := op^.next;
         op^.next := op2;
         op^.left := op2^.left;
         op2^.left := op2^.right;
         op2^.right := nil;
         op2^.opcode := pc_fjp;
         op2^.q := op^.q;
         op^.opcode := pc_tjp;
         op3 := pointer(Calloc(sizeof(intermediate_code)));
         op3^.opcode := dc_lab;
         op3^.optype := cgWord;
         op3^.q := GenLabel;
         op3^.next := op2^.next;
         op2^.next := op3;
         op^.q := op3^.q;
         PeepHoleOptimization(opv);
         end {else if}
      else
         JumpOptimizations(op, pc_tjp);
      end; {case pc_fjp}

   pc_inc: begin			{pc_inc}
      if op^.q = 0 then
         opv := op^.left
      else begin
	 opcode := op^.left^.opcode;
	 if opcode = pc_inc then begin
            if ord4(op^.left^.q) + ord4(op^.q) < ord4(maxint) then begin
               op^.q := op^.q + op^.left^.q;
               op^.left := op^.left^.left;
               end; {if}
            end {if}
	 else if opcode = pc_dec then begin
            q := op^.q - op^.left^.q;
            if q < 0 then begin
               q := -q;
               op^.opcode := pc_dec;
               end; {if}
            op^.q := q;
            op^.left := op^.left^.left;
            PeepHoleOptimization(opv);
            end {else if}
         else if opcode = pc_ldc then begin
            if op^.optype in [cgLong, cgULong] then begin
               op^.left^.lval := op^.left^.lval + op^.q;
               opv := op^.left;
               end {if}
            else if op^.optype in [cgUByte, cgByte, cgUWord, cgWord] then begin
               op^.left^.q := op^.left^.q + op^.q;
               opv := op^.left;
               end; {else if}
            end {else if}
         else if opcode in [pc_lao,pc_lda] then begin
            op^.left^.q := op^.left^.q + op^.q;
            opv := op^.left;
            end; {else if}
         end; {else}
      end; {case pc_inc}

   pc_ind: begin			{pc_ind}
      opcode := op^.left^.opcode;
      if opcode = pc_lda then begin
         op^.left^.opcode := pc_lod;
         op^.left^.optype := op^.optype;
         op^.left^.q := op^.left^.q + op^.q;
         opv := op^.left;
         end {if}
      else if opcode = pc_lao then begin
         op^.left^.opcode := pc_ldo;
         op^.left^.optype := op^.optype;
         op^.left^.q := op^.left^.q + op^.q;
         opv := op^.left;
         end {else if}
      else if opcode = pc_inc then begin
         if op^.left^.optype = cgULong then begin
            if ord4(op^.left^.q) + ord4(op^.q) < ord4(maxint - 1) then begin
               op^.q := op^.q + op^.left^.q;
               op^.left := op^.left^.left;
               PeepHoleOptimization(opv);
               end; {if}
            end; {if}
         end; {else if}
      end; {case pc_ind}

   pc_ior: begin			{pc_ior}
      if op^.right^.opcode = pc_ldc then begin
         if op^.left^.opcode = pc_ldc then begin
            op^.left^.q := ord((op^.left^.q <> 0) or (op^.right^.q <> 0));
            opv := op^.left;
            end {if}
         else begin
            if op^.right^.q <> 0 then begin
               if not SideEffects(op^.left) then begin
                  op^.right^.q := 1;
                  opv := op^.right;
                  end; {if}
               end {if}
            else
               op^.opcode := pc_neq;
            end {if}
         end {if}
      else if op^.left^.opcode = pc_ldc then
         if op^.left^.q <> 0 then begin
            op^.left^.q := 1;
            opv := op^.left;
            end; {if}
      end; {case pc_ior}

   pc_ixa: begin			{pc_ixa}
      if op^.right^.opcode = pc_ldc then begin
         optype := op^.optype;
         if optype in [cgUByte, cgByte, cgUWord, cgWord] then begin
            lval := op^.right^.q;
            if optype = cgUByte then
               lval := lval & $000000FF
            else if optype = cgUWord then
               lval := lval & $0000FFFF;
            done := false;
            if op^.left^.opcode in [pc_lao, pc_lda] then begin
               lq := op^.left^.q + lval;
               if (lq >= 0) and (lq < maxint) then begin
                  done := true;
                  op^.left^.q := ord(lq);
                  opv := op^.left;
                  end; {if}
               end; {if}
            if not done then begin
               op^.right^.lval := lval;
               op^.right^.optype := cgLong;
               op^.opcode := pc_adl;
               PeepHoleOptimization(opv);
               end; {if}
            end; {if}                   
         end {if}
      else if op^.left^.opcode = pc_lao then begin
         if op^.right^.opcode = pc_inc then begin
            lq := ord4(op^.right^.q) + ord4(op^.left^.q);
            if lq < maxint then begin
               op^.left^.q := ord(lq);
               op^.right := op^.right^.left;
               end; {if}
            PeepHoleOptimization(opv);
            end; {if}
         end {else if}
      else if op^.left^.opcode = pc_ixa then begin
         if smallMemoryModel then
            if op^.left^.left^.opcode in [pc_lao,pc_lda] then
               if op^.left^.left^.q = 0 then begin
                  op2 := op^.left;
                  op^.left := op^.left^.left;
                  op2^.left := op^.right;
                  op2^.opcode := pc_adi;
                  op^.right := op2;
                  op^.optype := cgUWord;
                  end; {if}
         end; {else if}
      end; {case pc_ixa}

   pc_leq, pc_les, pc_geq, pc_grt: begin  {pc_leq, pc_les, pc_geq, pc_grt}
      if op^.left^.opcode = pc_ldc then begin
         ReverseChildren(op);
         case op^.opcode of
            pc_leq: op^.opcode := pc_geq;
            pc_les: op^.opcode := pc_grt;
            pc_geq: op^.opcode := pc_leq;
            pc_grt: op^.opcode := pc_les;
            end; {case}
         end; {if}
      if (op^.optype = cgWord) then
         if (TypeOf(op^.right) = cgUByte)
            or ((op^.right^.opcode = pc_ldc) and (op^.right^.q >= 0)
                and (op^.right^.optype in [cgByte,cgUByte,cgWord])) then
            if (TypeOf(op^.left) = cgUByte)
               or ((op^.left^.opcode = pc_ldc) and (op^.left^.q >= 0)
                   and (op^.left^.optype in [cgByte,cgUByte,cgWord])) then
               op^.optype := cgUWord;
      if op^.right^.opcode = pc_ldc then
         if ((op^.optype = cgUWord) and (op^.right^.q = 0))
            or ((op^.optype = cgULong) and (op^.right^.lval = 0))
            or ((op^.optype = cgUQuad) 
               and (op^.right^.qval.lo = 0) and (op^.right^.qval.hi = 0)) then
            begin
            case op^.opcode of
               pc_leq: op^.opcode := pc_equ;
               pc_grt: op^.opcode := pc_neq;
               pc_les: if not SideEffects(op^.left) then begin
                          op^.right^.optype := cgWord;
                          op^.right^.q := 0;
                          opv := op^.right;
                          end; {if}
               pc_geq: if not SideEffects(op^.left) then begin
                          op^.right^.optype := cgWord;
                          op^.right^.q := 1;
                          opv := op^.right;
                          end; {if}
               end; {case}
            end {if}
         else if (op^.opcode = pc_leq) then
            if ((op^.optype = cgWord) and (op^.right^.q <> maxint))
               or ((op^.optype = cgUWord) and (op^.right^.q <> -1)) then begin
               op^.right^.q := op^.right^.q + 1;
               op^.opcode := pc_les;
               end; {if}
      end; {case pc_leq, pc_les, pc_geq, pc_grt}

   pc_lnd: begin			{pc_lnd}
      if op^.right^.opcode = pc_ldc then begin
         if op^.left^.opcode = pc_ldc then begin
            op^.left^.q := ord((op^.left^.lval <> 0) and (op^.right^.lval <> 0));
            op^.left^.optype := cgWord;
            opv := op^.left;
            end {if}
         else begin
            if op^.right^.lval = 0 then begin
               if not SideEffects(op^.left) then  begin
                  with op^.right^ do begin
                     lval := 0;
                     optype := cgWord;
                     q := 0;
                     end; {with}
                  opv := op^.right;
                  end; {if}
               end; {if}
            end; {if}
         end {if}
      else if op^.left^.opcode = pc_ldc then
         if op^.left^.lval = 0 then begin
            with op^.left^ do begin
               lval := 0;
               optype := cgWord;
               q := 0;
               end; {with}
            opv := op^.left;
            end; {if}
      end; {case pc_lnd}

   pc_lnm: begin			{pc_lnm}
      if op^.next^.opcode = pc_lnm then begin
         opv := op^.next;
         rescan := true;
         end; {if}
      end; {case pc_lnm}

   pc_lor: begin			{pc_lor}
      if op^.right^.opcode = pc_ldc then begin
         if op^.left^.opcode = pc_ldc then begin
            op^.left^.q := ord((op^.left^.lval <> 0) or (op^.right^.lval <> 0));
            optype := cgWord;
            opv := op^.left;
            end {if}
         else begin
            if op^.right^.lval <> 0 then begin
               if not SideEffects(op^.left) then begin
                  op^.right^.lval := 0;
                  op^.right^.q := 1;
                  op^.right^.optype := cgWord;
                  opv := op^.right;
                  end; {if}
               end {if}
            else begin
               op^.opcode := pc_neq;
               op^.optype := cgLong;
               end; {else}
            end; {if}
         end {if}
      else if op^.left^.opcode = pc_ldc then
         if op^.left^.lval <> 0 then begin
            op^.left^.lval := 0;
            op^.left^.q := 1;
            op^.left^.optype := cgWord;
            opv := op^.left;
            end; {if}
      end; {case pc_lor}

   pc_mdl: begin			{pc_mdl}
      if op^.right^.opcode = pc_ldc then 
         if op^.right^.lval = 1 then begin
            if not SideEffects(op^.left) then begin
               op^.right^.lval := 0;
               opv := op^.right;
               end; {if}
            end {if}
         else if op^.left^.opcode = pc_ldc then 
            if (op^.left^.lval >= 0) and (op^.right^.lval > 0) then begin
               op^.left^.lval := op^.left^.lval mod op^.right^.lval;
               opv := op^.left;
               end; {if}
      end; {case pc_mdl}

   pc_mdq: begin			{pc_mdq}
      if op^.right^.opcode = pc_ldc then 
         if (op^.right^.qval.lo = 1) and (op^.right^.qval.hi = 0) then begin
            if not SideEffects(op^.left) then begin
               op^.right^.qval := longlong0;
               opv := op^.right;
               end; {if}
            end {if}
         else if op^.left^.opcode = pc_ldc then
            if (op^.right^.qval.lo <> 0) or (op^.right^.qval.hi <> 0) then begin
               rem64(op^.left^.qval, op^.right^.qval);
               opv := op^.left;
               end; {if}
      end; {case pc_mdq}

   pc_mod: begin			{pc_mod}
      if op^.right^.opcode = pc_ldc then 
         if op^.right^.q = 1 then begin
            if not SideEffects(op^.left) then begin
               op^.right^.q := 0;
               opv := op^.right;
               end; {if}
            end {if}
         else if op^.left^.opcode = pc_ldc then 
            if (op^.left^.q >= 0) and (op^.right^.q > 0) then begin
               op^.left^.q := op^.left^.q mod op^.right^.q;
               opv := op^.left;
               end; {if}
      end; {case pc_mod}

   pc_mpi, pc_umi: begin		{pc_mpi, pc_umi}
      if (op^.right^.opcode = pc_ldc) and (op^.left^.opcode = pc_ldc) then begin
         if op^.opcode = pc_mpi then
            op^.left^.q := op^.left^.q*op^.right^.q
         else {if op^.opcode = pc_umi then} begin
            lval := umul(op^.left^.q & $0000FFFF, op^.right^.q & $0000FFFF);
            op^.left^.q := long(lval).lsw;
            end; {else}
         opv := op^.left;
         end {if}
      else begin
         if op^.left^.opcode = pc_ldc then
            ReverseChildren(op);
         if op^.right^.opcode = pc_ldc then begin
            q := op^.right^.q;
            if q = 1 then
               opv := op^.left
            else if q = 0 then begin
               if not SideEffects(op^.left) then
                  opv := op^.right;
               end {else if}
            else if (q = -1) and (op^.opcode = pc_mpi) then begin
               op^.opcode := pc_ngi;
               op^.right := nil;
               end {else if}
            else if OneBit(q) then begin
               op^.right^.q := Base(q);
               op^.opcode := pc_shl;
               PeepHoleOptimization(opv);
               end; {else if}
            end; {if}
         end; {else}
      end; {case pc_mpi, pc_umi}

   pc_mpl, pc_uml: begin		{pc_mpl, pc_uml}
      if (op^.right^.opcode = pc_ldc) and (op^.left^.opcode = pc_ldc) then begin
         if op^.opcode = pc_mpl then
            op^.left^.lval := op^.left^.lval*op^.right^.lval
         else {if op^.opcode = pc_uml then}
            op^.left^.lval := umul(op^.left^.lval, op^.right^.lval);
         opv := op^.left;
         end {if}
      else begin
         if op^.left^.opcode = pc_ldc then
            ReverseChildren(op);
         if op^.right^.opcode = pc_ldc then begin
            lval := op^.right^.lval;
            if lval = 1 then
               opv := op^.left
            else if lval = 0 then begin
               if not SideEffects(op^.left) then
                  opv := op^.right;
               end {else if}
            else if (lval = -1) and (op^.opcode = pc_mpl) then begin
               op^.opcode := pc_ngl;
               op^.right := nil;
               end {else if}
            else if OneBit(lval) then begin
               op^.right^.lval := Base(lval);
               op^.opcode := pc_sll;
               end; {else if}
            end; {if}
         end; {else}
      end; {case pc_mpl, pc_uml}

   pc_mpq, pc_umq: begin		{pc_mpq, pc_umq}
      if (op^.right^.opcode = pc_ldc) and (op^.left^.opcode = pc_ldc) then begin
         umul64(op^.left^.qval, op^.right^.qval);
         opv := op^.left;
         end {if}
      else begin
         if op^.left^.opcode = pc_ldc then
            ReverseChildren(op);
         if op^.right^.opcode = pc_ldc then begin
            if (op^.right^.qval.lo = 1) and (op^.right^.qval.hi = 0) then
               opv := op^.left
            else if (op^.right^.qval.lo = 0) and (op^.right^.qval.hi = 0) then
               begin
               if not SideEffects(op^.left) then
                  opv := op^.right;
               end {else if}
            else if (op^.right^.qval.lo = -1) and (op^.right^.qval.hi = -1) then
               if op^.opcode = pc_mpq then begin
                  op^.opcode := pc_ngq;
                  op^.right := nil;
                  end; {if}
            end; {if}
         end; {else}
      end; {case pc_mpq, pc_umq}

   pc_mpr: begin			{pc_mpr}
      if (op^.right^.opcode = pc_ldc) and (op^.left^.opcode = pc_ldc) then begin
         op^.left^.rval := op^.left^.rval*op^.right^.rval;
         opv := op^.left;
         end {if}
      else begin
         if op^.left^.opcode = pc_ldc then
            ReverseChildren(op);
         if op^.right^.opcode = pc_ldc then begin
            rval := op^.right^.rval;
            if rval = 1.0 then
               opv := op^.left
            else if rval = 0.0 then
               if fastMath then
                  if not SideEffects(op^.left) then
                     opv := op^.right;
            end; {if}
         end; {else}
      end; {case pc_mpr}

   pc_neq: begin			{pc_neq}
      if op^.left^.opcode = pc_ldc then
         ReverseChildren(op);
      if op^.right^.opcode = pc_ldc then begin
	 if op^.left^.opcode = pc_ldc then begin
            BinOps(op^.left, op^.right);
            case op^.left^.optype of
               cgByte,cgUByte,cgWord,cgUWord: begin
        	  op^.opcode := pc_ldc;
        	  op^.q := ord(op^.left^.q <> op^.right^.q);
        	  op^.left := nil;
        	  op^.right := nil;
        	  end;
               cgLong,cgULong: begin
        	  op^.opcode := pc_ldc;
        	  op^.q := ord(op^.left^.lval <> op^.right^.lval);
        	  op^.left := nil;
        	  op^.right := nil;
        	  end;
               cgQuad,cgUQuad: begin
        	  op^.opcode := pc_ldc;
        	  op^.q := ord((op^.left^.qval.lo <> op^.right^.qval.lo) or
        	               (op^.left^.qval.hi <> op^.right^.qval.hi));
        	  op^.left := nil;
        	  op^.right := nil;
        	  end;
               cgReal,cgDouble,cgComp,cgExtended: begin
        	  op^.opcode := pc_ldc;
        	  op^.q := ord(op^.left^.rval <> op^.right^.rval);
        	  op^.left := nil;
        	  op^.right := nil;
        	  end;
               cgVoid,ccPointer: begin
        	  op^.opcode := pc_ldc;
        	  op^.q := ord(op^.left^.pval <> op^.right^.pval);
        	  op^.left := nil;
        	  op^.right := nil;
        	  end;
               end; {case}
            op^.optype := cgWord;
            end {if}
         else if op^.right^.optype in [cgByte, cgUByte, cgWord, cgUWord] then begin
            if op^.right^.q = 0 then
               if op^.left^.opcode in
         	  [pc_and,pc_ior,pc_neq,pc_equ,pc_geq,pc_leq,pc_les,pc_grt,pc_not]
                  then begin
                  opv := op^.left;
                  opv^.next := op^.next;
                  end; {if}
            end {else if}
         else if op^.right^.optype in [cgLong, cgULong] then begin
            if op^.right^.lval = 0 then
               if op^.left^.opcode in
         	  [pc_and,pc_ior,pc_neq,pc_equ,pc_geq,pc_leq,pc_les,pc_grt,pc_not]
                  then begin
                  opv := op^.left;
                  opv^.next := op^.next;
                  end; {if}
            end; {else if}
         end; {if}                      
      end; {case pc_neq}

   pc_ngi: begin			{pc_ngi}
      if op^.left^.opcode = pc_ldc then begin
         op^.left^.q := -op^.left^.q;
         opv := op^.left;
         end; {if}
      end; {case pc_ngi}

   pc_ngl: begin			{pc_ngl}
      if op^.left^.opcode = pc_ldc then begin
         op^.left^.lval := -op^.left^.lval;
         opv := op^.left;
         end; {if}
      end; {case pc_ngl}

   pc_ngq: begin			{pc_ngq}
      if op^.left^.opcode = pc_ldc then begin
         with op^.left^.qval do begin
            lo := ~lo;
            hi := ~hi;
            lo := lo + 1;
            if lo = 0 then
               hi := hi + 1;
            end; {with}
         opv := op^.left;
         end; {if}
      end; {case pc_ngq}

   pc_ngr: begin			{pc_ngr}
      if op^.left^.opcode = pc_ldc then begin
         op^.left^.rval := -op^.left^.rval;
         opv := op^.left;
         end; {if}
      end; {case pc_ngr}

   pc_not: begin			{pc_not}
      opcode := op^.left^.opcode;
      if opcode = pc_ldc then begin
         if op^.left^.optype in [cgByte,cgUByte,cgWord,cgUWord] then begin
            op^.left^.q := ord(op^.left^.q = 0);
            opv := op^.left;
            end {if}
         else if op^.left^.optype in [cgLong,cgULong] then begin
            q := ord(op^.left^.lval = 0);
            op^.left^.q := q;
            op^.left^.optype := cgWord;
            opv := op^.left;
            end {else if}
         else if op^.left^.optype in [cgQuad,cgUQuad] then begin
            q := ord((op^.left^.qval.lo = 0) and (op^.left^.qval.hi = 0));
            op^.left^.q := q;
            op^.left^.optype := cgWord;
            opv := op^.left;
            end; {else if}
         end {if}
      else if opcode = pc_equ then begin
         op^.left^.opcode := pc_neq;
         opv := op^.left;
         end {else if}
      else if opcode = pc_neq then begin
         op^.left^.opcode := pc_equ;
         opv := op^.left;
         end {else if}
      else if opcode = pc_geq then begin
         op^.left^.opcode := pc_les;
         opv := op^.left;
         end {else if}
      else if opcode = pc_grt then begin
         op^.left^.opcode := pc_leq;
         opv := op^.left;
         end {else if}
      else if opcode = pc_les then begin
         op^.left^.opcode := pc_geq;
         opv := op^.left;
         end {else if}
      else if opcode = pc_leq then begin
         op^.left^.opcode := pc_grt;
         opv := op^.left;
         end; {else if}
      end; {case pc_not}

   pc_pop: begin			{pc_pop}
      if op^.left^.opcode = pc_cnv then begin
         fromtype.i := (op^.left^.q & $00F0) >> 4;
         op^.optype := fromtype.optype;
         op^.left := op^.left^.left;
         end; {if}
      opcode := op^.left^.opcode;
      if opcode = pc_cop then begin
         op^.left^.opcode := pc_str;
         opv := op^.left;
         opv^.next := op^.next;
         PeepHoleOptimization(opv);
         end {if}            
      else if opcode = pc_cpi then begin
         op^.left^.opcode := pc_sto;
         opv := op^.left;
         opv^.next := op^.next;
         PeepHoleOptimization(opv);
         end {else if}
      else if opcode = pc_cbf then begin
         op^.left^.opcode := pc_sbf;
         opv := op^.left;
         opv^.next := op^.next;
         end {else if}
      else if opcode = pc_cpo then begin
         op^.left^.opcode := pc_sro;
         opv := op^.left;
         opv^.next := op^.next;
         PeepHoleOptimization(opv);
         end {else if}
      else if opcode in [pc_inc,pc_dec] then
         op^.left := op^.left^.left;
      end; {case pc_pop}

   pc_ret: begin			{pc_ret}
      RemoveDeadCode(op);
      end; {case pc_ret}

   pc_sbi: begin			{pc_sbi}
      if op^.left^.opcode = pc_ldc then begin
         if op^.right^.opcode = pc_ldc then begin
            op^.left^.q := op^.left^.q - op^.right^.q;
            opv := op^.left;
            end {if}
         else if op^.left^.q = 0 then begin
            op^.opcode := pc_ngi;
            op^.left := op^.right;
            op^.right := nil;
            end; {else if}
         end {if}
      else if op^.right^.opcode = pc_ldc then begin
         q := op^.right^.q;
         if q = 0 then
            opv := op^.left
         else if (q > 0) then begin
            op^.opcode := pc_dec;
            op^.q := q;
            op^.right := nil;
            end {else if}
         else {if q < 0) then} begin
            op^.opcode := pc_inc;
            op^.q := -q;
            op^.right := nil;
            end; {else if}
         end {if}
      else if op^.left^.opcode in [pc_inc,pc_dec] then
         if op^.right^.opcode in [pc_inc,pc_dec] then begin
            op2 := op^.left;
            if op^.left^.opcode = pc_inc then
               q := op^.left^.q
            else
               q := -op^.left^.q;
            if op^.right^.opcode = pc_inc then
               q := q - op^.right^.q
            else
               q := q + op^.right^.q;
            if q >= 0 then begin
               op2^.opcode := pc_inc;
               op2^.q := q;
               end {if}
            else begin
               op2^.opcode := pc_dec;
               op2^.q := -q;
               end; {else}
            op^.left := op^.left^.left;
            op^.right := op^.right^.left;
            op2^.left := op;
            opv := op2;
            PeepHoleOptimization(opv);
            end; {if}
      end; {case pc_sbi}

   pc_sbl: begin			{pc_sbl}
      if op^.left^.opcode = pc_ldc then begin
         if op^.right^.opcode = pc_ldc then begin
            op^.left^.lval := op^.left^.lval - op^.right^.lval;
            opv := op^.left;
            end {if}
         else if op^.left^.lval = 0 then begin
            op^.opcode := pc_ngl;
            op^.left := op^.right;
            op^.right := nil;
            end; {else if}
         end {if}
      else if op^.right^.opcode = pc_ldc then begin
         lval := op^.right^.lval;
         if lval = 0 then
            opv := op^.left
         else if (lval > 0) and (lval <= maxint) then begin
            op^.opcode := pc_dec;
            op^.q := ord(lval);
            op^.right := nil;
            op^.optype := cgLong;
            end {else if}
         else if (lval > -maxint) and (lval < 0) then begin
            op^.opcode := pc_inc;
            op^.q := -ord(lval);
            op^.right := nil;
            op^.optype := cgLong;
            end; {else if}       
         end; {if}
      end; {case pc_sbl}

   pc_sbr: begin			{pc_sbr}
      if op^.left^.opcode = pc_ldc then begin
         if op^.right^.opcode = pc_ldc then begin
            op^.left^.rval := op^.left^.rval - op^.right^.rval;
            opv := op^.left;
            end {if}
         else if op^.left^.rval = 0.0 then
            if fastMath then begin
               op^.opcode := pc_ngr;
               op^.left := op^.right;
               op^.right := nil;
               end; {if}
         end {if}
      else if op^.right^.opcode = pc_ldc then begin
         if fastMath then
            if op^.right^.rval = 0.0 then
               opv := op^.left;
         end; {if}
      end; {case pc_sbr}

   pc_sbq: begin			{pc_sbq}
      if op^.left^.opcode = pc_ldc then begin
         if op^.right^.opcode = pc_ldc then begin
            sub64(op^.left^.qval, op^.right^.qval);
            opv := op^.left;
            end {if}
         else if (op^.left^.qval.lo = 0) and (op^.left^.qval.hi = 0) then begin
            op^.opcode := pc_ngq;
            op^.left := op^.right;
            op^.right := nil;
            end; {else if}
         end {if}
      else if op^.right^.opcode = pc_ldc then begin
         if (op^.right^.qval.lo = 0) and (op^.right^.qval.hi = 0) then
            opv := op^.left;
         end; {if}
      end; {case pc_sbq}

   pc_shl: begin			{pc_shl}
      if op^.right^.opcode = pc_ldc then begin
         opcode := op^.left^.opcode;
         if opcode = pc_ldc then begin
            op^.left^.q := op^.left^.q << op^.right^.q;
            opv := op^.left;
            end {if}
         else if opcode = pc_shl then begin
            if op^.left^.right^.opcode = pc_ldc then begin
               op^.right^.q := op^.right^.q + op^.left^.right^.q;
               op^.left := op^.left^.left;
               end; {if}
            end {if}
         else if opcode = pc_inc then begin
            op2 := op^.left;
            op^.left := op2^.left;
            op2^.q := op2^.q << op^.right^.q;
            op2^.left := op;
            opv := op2;
            PeepHoleOptimization(op2^.left);
            end {else if}
         else if op^.right^.q = 0 then
            opv := op^.left;
         end; {if}
      end; {case pc_shl}

   pc_shr: begin			{pc_shr}
      if op^.right^.opcode = pc_ldc then begin
         if op^.left^.opcode = pc_ldc then begin
            op^.left^.q := op^.left^.q >> op^.right^.q;
            opv := op^.left;
            end {if}
         else if op^.right^.q = 0 then
            opv := op^.left;
         end; {if}
      end; {case pc_shr}

   pc_sll: begin			{pc_sll}
      if op^.right^.opcode = pc_ldc then begin
         if op^.left^.opcode = pc_ldc then begin
            op^.left^.lval := op^.left^.lval << op^.right^.lval;
            opv := op^.left;
            end {if}
         else if op^.right^.lval = 0 then
            opv := op^.left;
         end; {if}
      end; {case pc_sll}

   pc_slr: begin			{pc_slr}
      if op^.right^.opcode = pc_ldc then begin
         if op^.left^.opcode = pc_ldc then begin
            op^.left^.lval := op^.left^.lval >> op^.right^.lval;
            opv := op^.left;
            end {if}
         else if op^.right^.lval = 0 then
            opv := op^.left;
         end; {if}
      end; {case pc_slr}

   pc_slq: begin			{pc_slq}
      if op^.right^.opcode = pc_ldc then begin
         if op^.left^.opcode = pc_ldc then begin
            shl64(op^.left^.qval, op^.right^.q);
            opv := op^.left;
            end {if}
         else if op^.right^.q = 0 then
            opv := op^.left;
         end; {if}
      end; {case pc_slq}

   pc_sro, pc_str: begin		{pc_sro, pc_str}
      if op^.optype in [cgReal,cgDouble,cgExtended,cgComp] then
         RealStoreOptimizations(op, op^.left);
      end; {case pc_sro, pc_str}

   pc_sto: begin			{pc_sto}
      if op^.optype in [cgReal,cgDouble,cgExtended,cgComp] then
         RealStoreOptimizations(op, op^.right);
      if op^.left^.opcode = pc_lao then begin
         op^.q := op^.left^.q;
         op^.lab := op^.left^.lab;
         op^.opcode := pc_sro;
         op^.left := op^.right;
         op^.right := nil;
         end {if}
      else if op^.left^.opcode = pc_lda then begin
         op^.q := op^.left^.q;
         op^.r := op^.left^.r;
         op^.opcode := pc_str;
         op^.left := op^.right;
         op^.right := nil;
         end; {if}
      end; {case pc_sto}

   pc_sqr: begin			{pc_sqr}
      if op^.right^.opcode = pc_ldc then begin
         if op^.left^.opcode = pc_ldc then begin
            ashr64(op^.left^.qval, op^.right^.q);
            opv := op^.left;
            end {if}
         else if op^.right^.q = 0 then
            opv := op^.left;
         end; {if}
      end; {case pc_sqr}

   pc_tjp: begin			{pc_tjp}
      opcode := op^.left^.opcode;
      if opcode = pc_ldc then begin
         if op^.left^.optype in [cgByte, cgUByte, cgWord, cgUWord] then
            if op^.left^.q = 0 then begin
               opv := op^.next;
               rescan := true;
               end {if}
            else begin
               op^.opcode := pc_ujp;
               op^.left := nil;
               PeepHoleOptimization(opv);
               end; {else}
         end {if}
      else if opcode = pc_ior then begin
         op2 := op^.left;
         op2^.next := op^.next;
         op^.next := op2;
         op^.left := op2^.left;
         op2^.left := op2^.right;
         op2^.right := nil;
         op2^.opcode := pc_tjp;
         op2^.q := op^.q;
         PeepHoleOptimization(opv);
         end {else if}
      else if opcode = pc_and then begin
         op2 := op^.left;
         op2^.next := op^.next;
         op^.next := op2;
         op^.left := op2^.left;
         op2^.left := op2^.right;
         op2^.right := nil;
         op2^.opcode := pc_tjp;
         op2^.q := op^.q;
         op^.opcode := pc_fjp;
         op3 := pointer(Calloc(sizeof(intermediate_code)));
         op3^.opcode := dc_lab;
         op3^.optype := cgWord;
         op3^.q := GenLabel;
         op3^.next := op2^.next;
         op2^.next := op3;
         op^.q := op3^.q;
         PeepHoleOptimization(opv);
         end {else if}
      else
         JumpOptimizations(op, pc_fjp);
      end; {case pc_tjp}

   pc_tri: begin			{pc_tri}
      opcode := op^.left^.opcode;
      if opcode = pc_not then begin
         ReverseChildren(op^.right);
         op^.left := op^.left^.left;
         PeepHoleOptimization(opv);
         end {if}
      else if opcode in [pc_equ, pc_neq] then begin
	 with op^.left^.right^ do
            if opcode = pc_ldc then
               if optype in [cgByte,cgUByte,cgWord,cgUWord] then
        	  if q = 0 then begin
                     if op^.left^.opcode = pc_equ then
			ReverseChildren(op^.right);
                     op^.left := op^.left^.left;
                     end; {if}
         end {else if}
      else if opcode = pc_ldc then
         if op^.left^.optype in [cgWord,cgUWord] then
            if op^.next = nil then
               if op^.left^.q <> 0 then begin
                  if op^.optype = TypeOf(op^.right^.left) then
                     opv := op^.right^.left;
                  end {if}
               else
                  if op^.optype = TypeOf(op^.right^.right) then
                     opv := op^.right^.right;
      end; {case pc_tri}

   pc_udi: begin			{pc_udi}
      if op^.right^.opcode = pc_ldc then begin
         q := op^.right^.q;
         if op^.left^.opcode = pc_ldc then begin
            if q <> 0 then begin
               op^.left^.q := ord(udiv(op^.left^.q & $0000FFFF, q & $0000FFFF));
               opv := op^.left;
               end; {if}
            end {if}
         else if q = 1 then
            opv := op^.left
         else if OneBit(q) then begin
            op^.right^.q := Base(q);
            op^.opcode := pc_usr;
            end; {else if}
         end; {if}
      end; {case pc_udi}

   pc_udl: begin			{pc_udl}
      if op^.right^.opcode = pc_ldc then begin
         lq := op^.right^.lval;
         if op^.left^.opcode = pc_ldc then begin
            if lq <> 0 then begin
               op^.left^.lval := udiv(op^.left^.lval, lq);
               opv := op^.left;
               end; {if}
            end {if}
         else if lq = 1 then
            opv := op^.left
         else if OneBit(lq) then begin
            op^.right^.lval := Base(lq);
            op^.opcode := pc_vsr;
            end; {else if}
         end; {if}
      end; {case pc_udl}

   pc_udq: begin			{pc_udq}
      if op^.right^.opcode = pc_ldc then begin
         if op^.left^.opcode = pc_ldc then begin
            if (op^.right^.qval.lo <> 0) or (op^.right^.qval.hi <> 0) then begin
               udiv64(op^.left^.qval, op^.right^.qval);
               opv := op^.left;
               end; {if}
            end {if}
         else if (op^.right^.qval.lo = 1) and (op^.right^.qval.hi = 0) then
            opv := op^.left;
         end; {if}
      end; {case pc_udq}

   pc_uim: begin			{pc_uim}
      if op^.right^.opcode = pc_ldc then 
         if op^.right^.q = 1 then begin
            if not SideEffects(op^.left) then begin
               op^.right^.q := 0;
               opv := op^.right;
               end; {if}
            end {if}
         else if op^.left^.opcode = pc_ldc then 
            if op^.right^.q <> 0 then begin
               op^.left^.q :=
                  ord(umod(op^.left^.q & $0000FFFF, op^.right^.q & $0000FFFF));
               opv := op^.left;
               end; {if}
      end; {case pc_uim}

   pc_ujp: begin			{pc_ujp}
      RemoveDeadCode(op);
      if op^.next^.opcode = dc_lab then begin
         if op^.q = op^.next^.q then begin
            opv := op^.next;
            rescan := true;
            end {if}
         else if op^.next^.next^.opcode = dc_lab then
            if op^.next^.next^.q = op^.q then begin
               opv := op^.next;
               rescan := true;
               end; {if}
         end; {if}
      end; {case pc_ujp}

   pc_ulm: begin			{pc_ulm}
      if op^.right^.opcode = pc_ldc then 
         if op^.right^.lval = 1 then begin
            if not SideEffects(op^.left) then begin
               op^.right^.lval := 0;
               opv := op^.right;
               end; {if}
            end {if}
         else if op^.left^.opcode = pc_ldc then 
            if op^.right^.lval <> 0 then begin
               op^.left^.lval := umod(op^.left^.lval, op^.right^.lval);
               opv := op^.left;
               end; {if}
      end; {case pc_ulm}

   pc_uqm: begin			{pc_uqm}
      if op^.right^.opcode = pc_ldc then 
         if (op^.right^.qval.lo = 1) and (op^.right^.qval.hi = 0) then begin
            if not SideEffects(op^.left) then begin
               op^.right^.qval := longlong0;
               opv := op^.right;
               end; {if}
            end {if}
         else if op^.left^.opcode = pc_ldc then
            if (op^.right^.qval.lo <> 0) or (op^.right^.qval.hi <> 0) then begin
               umod64(op^.left^.qval, op^.right^.qval);
               opv := op^.left;
               end; {if}
      end; {case pc_uqm}

   pc_usr: begin			{pc_usr}
      if op^.right^.opcode = pc_ldc then begin
         if op^.left^.opcode = pc_ldc then begin
            lval := lshr(op^.left^.q & $0000FFFF, op^.right^.q);
            op^.left^.q := long(lval).lsw;
            opv := op^.left;
            end {if}
         else if op^.right^.q = 0 then
            opv := op^.left;
         end; {if}
      end; {case pc_usr}

   pc_vsr: begin			{pc_vsr}
      if op^.right^.opcode = pc_ldc then begin
         if op^.left^.opcode = pc_ldc then begin
            op^.left^.lval := lshr(op^.left^.lval, op^.right^.lval);
            opv := op^.left;
            end {if}
         else if op^.right^.lval = 0 then
            opv := op^.left;
         end; {if}
      end; {case pc_vsr}

   pc_wsr: begin			{pc_wsr}
      if op^.right^.opcode = pc_ldc then begin
         if op^.left^.opcode = pc_ldc then begin
            lshr64(op^.left^.qval, op^.right^.q);
            opv := op^.left;
            end {if}
         else if op^.right^.q = 0 then
            opv := op^.left;
         end; {if}
      end; {case pc_wsr}

   otherwise: ;
   end; {case}
end; {PeepHoleOptimization}

{- Common Subexpression Elimination ----------------------------}

function MatchLoc (op1, op2: icptr): boolean;

{ See if two loads, stores or copies refer to the same		}
{ location							}
{								}
{ parameters:							}
{    op1, op2 - operations to check				}
{								}
{ Returns: True if they do, false if they don't.		}

begin {MatchLoc}
MatchLoc := false;
if (op1^.opcode in [pc_str,pc_cop,pc_lod,pc_lli,pc_lil,pc_lld,pc_ldl,pc_lda])
   and (op2^.opcode in [pc_str,pc_cop,pc_lod,pc_lli,pc_lil,pc_lld,pc_ldl,pc_lda]) then begin
   if op1^.r = op2^.r then
      MatchLoc := true;
   end {if}
else if (op1^.opcode in [pc_sro,pc_cpo,pc_ldo,pc_gli,pc_gil,pc_gld,pc_gdl,pc_lao])
   and (op2^.opcode in [pc_sro,pc_cpo,pc_ldo,pc_gli,pc_gil,pc_gld,pc_gdl,pc_lao]) then
   if op1^.lab^ = op2^.lab^ then
      MatchLoc := true;
end; {MatchLoc}                       


function Member (op: icptr; list: iclist): boolean;

{ See if the operand of a load is referenced in a list		}
{								}
{ parameters:							}
{    op - load to check						}
{    list - list to check					}
{								}
{ Returns: True if op is in list, else false.			}
{								}
{ Notes: As a side effect, this subroutine sets memberOp to	}
{    point to any matching member; memberOp is undefined if	}
{    there is no matching member.				}

begin {Member}
Member := false;
while list <> nil do begin
   if MatchLoc(op, list^.op) then begin
      Member := true;
      memberOp := list^.op;
      list := nil;
      end {if}
   else
      list := list^.next;
   end; {while}
end; {Member}


function TypeOf {(op: icptr): baseTypeEnum};

{ find the type for the expression tree				}
{								}
{ parameters:							}
{    op - tree for which to find the type			}
{								}
{ Returns: base type						}

begin {TypeOf}
case op^.opcode of
   pc_gil, pc_gli, pc_gdl, pc_gld, pc_iil, pc_ili, pc_idl, pc_ild,
   pc_ldc, pc_ldo, pc_lil, pc_lli, pc_ldl, pc_lld, pc_lod, pc_dec,
   pc_inc, pc_ind, pc_lbf, pc_lbu, pc_cop, pc_cbf, pc_cpi, pc_cpo,
   pc_tri, pc_cup, pc_cui:
      TypeOf := op^.optype;

   pc_lad, pc_lao, pc_lca, pc_lda, pc_psh, pc_ixa:
      TypeOf := cgULong;

   pc_nop, pc_bnt, pc_ngi, pc_not, pc_adi, pc_and, pc_lnd, pc_bnd,
   pc_bor, pc_bxr, pc_dvi, pc_equ, pc_geq, pc_grt, pc_leq, pc_les,
   pc_neq, pc_ior, pc_lor, pc_mod, pc_mpi, pc_sbi, pc_shl, pc_shr:
      TypeOf := cgWord;

   pc_udi, pc_uim, pc_umi, pc_usr, pc_rbo:
      TypeOf := cgUWord;
                         
   pc_bnl, pc_ngl, pc_adl, pc_bal, pc_blr, pc_blx, pc_dvl, pc_mdl,
   pc_mpl, pc_sbl, pc_sll, pc_slr:
      TypeOf := cgLong;

   pc_udl, pc_ulm, pc_uml, pc_vsr:
      TypeOf := cgULong;

   pc_bnq, pc_ngq, pc_bqr, pc_bqx, pc_baq, pc_adq, pc_sbq, pc_mpq,
   pc_dvq, pc_mdq, pc_slq, pc_sqr:
      TypeOf := cgQuad;

   pc_umq, pc_udq, pc_uqm, pc_wsr:
      TypeOf := cgUQuad;

   pc_ngr, pc_adr, pc_dvr, pc_mpr, pc_sbr:
      TypeOf := cgExtended;

   pc_cnn, pc_cnv:                                        
      TypeOf := baseTypeEnum(op^.q & $000F);

   pc_stk:
      TypeOf := TypeOf(op^.left);

   pc_bno:
      TypeOf := TypeOf(op^.right);

   pc_tl1:				{pc_tl1 doesn't have type info.}
      TypeOf := cgVoid;			{Just return cgVoid for now.}

   otherwise: Error(cge1);       
   end; {case}
end; {TypeOf}


procedure CommonSubexpressionElimination;

{ Remove common subexpressions					}

type
   localPtr = ^localRecord;		{list of local temp variables}
   localRecord = record
      next: localPtr;			{next label in list}
      inUse: boolean;			{is this temp already in use?}
      size: integer;			{size of the temp area}
      lab: integer;			{label number}
      end;

var
   bb: blockPtr;			{used to trace basic block lists}
   done: boolean;			{for loop termination tests}
   op: icptr;				{used to trace operation lists, trees}
   lop: icptr;				{predecessor of op}
   temps: localPtr;			{list of temp variables}


   procedure DisposeTemps;

   { dispose of the list of temp variables			}

   var
      tp: localPtr;			{temp pointer}

   begin {DisposeTemps}
   while temps <> nil do begin
      tp := temps;
      temps := tp^.next;
      dispose(tp);
      end; {while}
   end; {DisposeTemps}


   function GetTemp (bb: blockPtr; size: integer): integer;

   { Allocate a temp storage location				}
   {								}
   { parameters:						}
   {    bb - block in which the temp is allocated		}
   {    size - size of the temp					}
   {								}
   { Returns: local label number for the temp			}

   var
      lab: integer;			{label number}
      loc: icptr;			{for dc_loc instruction}
      tp: localPtr;			{used to trace lists, allocate new items}

   begin {GetTemp}
   lab := 0;				{no label found, yet}
   tp := temps;				{try for a temp of the exact size}
   while tp <> nil do begin
      if not tp^.inUse then
         if tp^.size = size then begin
            lab := tp^.lab;
            tp^.inUse := true;
            tp := nil;
            end; {if}
      if tp <> nil then
         tp := tp^.next;
      end; {while}
   if lab = 0 then begin		{try for a larger temp}
      tp := temps;
      while tp <> nil do begin
	 if not tp^.inUse then
            if tp^.size > size then begin
               lab := tp^.lab;
               tp^.inUse := true;
               tp := nil;        
               end; {if}
	 if tp <> nil then
            tp := tp^.next;
	 end; {while}
      end; {if}
   if lab = 0 then begin		{allocate a new temp}
      loc := pointer(Calloc(sizeof(intermediate_code)));
      loc^.opcode := dc_loc;
      loc^.optype := cgWord;
      maxLoc := maxLoc + 1;
      loc^.r := maxLoc;
      lab := maxLoc;
      loc^.q := size;
      if bb^.code = nil then begin
	 loc^.next := nil;
	 bb^.code := loc;
         end {if}
      else begin
	 loc^.next := bb^.code^.next;
	 bb^.code^.next := loc;
         end; {else}
      new(tp);
      tp^.next := temps;
      temps := tp;
      tp^.inUse := true;
      tp^.size := loc^.q;
      tp^.lab := lab;
      end; {if}
   GetTemp := lab;			{return the temp label number}
   end; {GetTemp}


   procedure ResetTemps;

   { Mark all temps as available				}

   var
      tp: localPtr;			{temp pointer}

   begin {ResetTemps}
   tp := temps;
   while tp <> nil do begin
      tp^.inUse := false;
      tp := tp^.next;
      end; {while}
   end; {ResetTemps}


   procedure CheckForBlocks (op: icptr);

   { Scan a tree for blocked instructions			}
   {								}
   { parameters:						}
   {    op - tree to check					}
   {								}
   { Notes: Some code takes less time to execute than saving	}
   {    and storing the intermediate value.  This subroutine	}
   {    identifies such patterns.				}


      function Block (op: icptr): boolean;

      { See if the pattern should be blocked			}
      {								}
      { parameters:						}
      {    op - pattern to check				}
      {								}
      { Returns: True if the pattern should be blocked, else	}
      {    false.						}

      var
         opcode: pcodes;		{temp opcode}

      begin {Block}
      Block := false;
      opcode := op^.opcode;
      if opcode = pc_ixa then begin
         if op^.left^.opcode in [pc_lao,pc_lca,pc_lda] then
            Block := true;
         end {else if}
      else if opcode = pc_shl then begin
         if op^.right^.opcode = pc_ldc then
            if op^.right^.q = 1 then
               if op^.parents <= 3 then
                  Block := true;
         end {else if}
      else if opcode = pc_stk then
         Block := true
      else if opcode = pc_psh then
         Block := true
      else if opcode = pc_cnv then
         if op^.q & $000F = ord(cgVoid) then
            Block := true;
      end; {Block}


      function Max (a, b: integer): integer;

      { Return the larger of two integers			}
      {								}
      { parameters:						}
      {    a, b - integers to check				}
      {								}
      { Returns: a if a > b, else b				}

      begin {Max}
      if a > b then
         Max := a
      else
         Max := b;
      end; {Max}


   begin {CheckForBlocks}
   if Block(op) then begin
      if op^.left <> nil then		{handle a blocked instruction}
         op^.left^.parents := op^.left^.parents + Max(op^.parents - 1, 0);
      if op^.right <> nil then
         op^.right^.parents := op^.right^.parents + Max(op^.parents - 1, 0);
      op^.parents := 1;
      end; {if}
   if op^.left <> nil then		{check the children}
      CheckForBlocks(op^.left);
   if op^.right <> nil then
      CheckForBlocks(op^.right);
   end; {CheckForBlocks}


   procedure CheckTree (var op: icptr; bb: blockPtr);

   { check the trees used by op for common subexpressions	}
   {								}
   { parameters:						}
   {    op - operation to check					}
   {    bb - start of the current BASIC block			}

   var
      op2: icptr;			{result from Match calls}
      op3: icptr;			{used to trace the codes in a block}


      function Match (var op: icptr; tree: icptr): icptr;

      { Check for matches to op in tree				}
      {								}
      { parameters:						}
      {    op - operation to check				}
      {    tree - tree to examine for matches			}
      {								}
      { Returns: pointer to matching node or nil if none found	}

      var
         op2: icptr;			{result from recursive Match calls}
         kill, start, stop: boolean;	{used by Scan}
         skip: boolean;			{used to see if children should be scanned}


         procedure Combine (var op1, op2: icptr);

         { Op2 is a save or copy of the same value as op1; use a copy	}
         { for op2.							}
         {								}
         { parameters:							}
         {    op1 - first copy or save					}
         {    op2 - copy or save to optimize				}

         var
            op3: icptr;				{work pointer}

         begin {Combine}
         done := false;				{force another labeling pass}
	 op3 := op2;				{remove op2 from the list}
         if op3^.opcode in [pc_str,pc_sro] then begin
            if op3^.opcode = pc_str then
               op3^.opcode := pc_cop
            else
               op3^.opcode := pc_cpo;
            op2 := op3^.next;
            op3^.next := nil;
            end {if}
         else
            op2 := op3^.left;
         if op2 = nil then begin
            op2 := pointer(Calloc(sizeof(intermediate_code)));
            op2^.opcode := pc_nop;
            op2^.optype := cgWord;
            end; {if}
         op1^.left := op3;			{place in the new location}
         end; {Combine}


         function SameTree (list, op1, op2: icptr): boolean;

         { Are op1 and op2 in the same expression tree?			}
         {								}
         { parameters:							}
         {    list - list of expression trees				}
         {    op1, op2 - operations to check				}


            function InTree (tree, op: icptr): boolean;

            { See if op is in the tree					}
            {								}
            { parameters:						}
            {    tree - expression tree to check			}
            {    op - operatio to look for				}

            begin {InTree}
            if tree = nil then
               InTree := false
            else if tree = op then
               InTree := true
            else
               InTree := InTree(tree^.left, op) or InTree(tree^.right, op);
            end; {InTree}


         begin {SameTree}
         SameTree := false;
         while list <> nil do
            if InTree(list, op1) then begin
               SameTree := InTree(list, op2);
               list := nil;
               end {if}
            else
               list := list^.next;
         end; {SameTree}


         procedure Scan (list, op1, op2: icptr);

         { Check to see if any operation between op1 and op2 kills the	}
         { optimization							}
         {								}
         { parameters:							}
         {    list - instruction stream					}
         {    op1 - starting operation					}
         {    op2 - ending operation					}
         {								}
         { globals:							}
         {    kill - set to true if the optimization must be blocked,	}
         {       or false if it can be performed			}
         {    start - has op1 been found?  (initialize to false)	}
         {    stop - has kill been set?	 (initialize to false)		}

         label 1;

         begin {Scan}
1:       if not start then			{see if it is time to start}
            if list = op1 then
               start := true;
         if list^.left <> nil then		{scan the children}
            Scan(list^.left, op1, op2);
         if not stop then
            if list^.right <> nil then
               Scan(list^.right, op1, op2);
         if start then				{check for a kill or termination}
            if not stop then
               if list = op2 then begin
        	  kill := false;
        	  stop := true;
        	  end {if}
        	                                {kill indirect accesses on stores}
        	                                {to indirectly-accessible locations}
               else if op1^.opcode in [pc_sto,pc_cpi,pc_iil,pc_ili,pc_idl,pc_ild,
        	  pc_cup,pc_cui,pc_tl1,pc_ind,pc_sbf,pc_cbf] then begin
        	  if list^.opcode in [pc_sto,pc_cpi,pc_iil,pc_ili,pc_idl,pc_ild,
        	  pc_cup,pc_cui,pc_tl1,pc_sbf,pc_cbf] then begin
        	     kill := true;
        	     stop := true;
        	     end {if}
        	  else if list^.opcode in [pc_str,pc_sro,pc_cop,pc_cpo,pc_lli,
        	  pc_lil,pc_lld,pc_ldl,pc_gli,pc_gil,pc_gld,pc_gdl] then
        	     if Member(list, c_ind) then begin
        	        kill := true;
        	        stop := true;
        	        end {if}
        	  end {else if}
               else if list^.opcode in [pc_str,pc_sro,pc_cop,pc_cpo,pc_lli,pc_lil,
        	  pc_lld,pc_ldl,pc_gli,pc_gil,pc_gld,pc_gdl] then begin
        	  if MatchLoc(list, op2) then begin
                     kill := true;
                     stop := true;
                     end {if}
        	  end {else if}
               else if list^.opcode in [pc_sto,pc_cpi,pc_iil,pc_ili,pc_idl,pc_ild,
        	  pc_cup,pc_cui,pc_tl1,pc_sbf,pc_cbf] then
        	  if Member(op1, c_ind) or (op1^.opcode in [pc_lbf,pc_lbu]) then
                     begin
                     kill := true;
                     stop := true;
                     end; {if}
         if not stop then			{scan forward in the stream}
            if list^.next <> nil then begin
               list := list^.next;
               goto 1;
               end; {if}
         end; {Scan}


      begin {Match}
      op2 := nil;			{check for an exact match}
      skip := false;
      if not (op^.opcode in [pc_str,pc_sro]) and CodesMatch(op, tree, true)
         then begin
         if op = tree then
            op2 := tree
         else begin
            start := false;
            stop := false;
            Scan(bb^.code, tree, op);
            if not kill then
               op2 := tree;
            end; {else}
         end {if}
					{check for stores of a common value}
      else if op^.opcode in [pc_str,pc_sro,pc_cop,pc_cpo] then
         if tree^.opcode in [pc_str,pc_sro,pc_cop,pc_cpo] then
            if op^.left = tree^.left then begin
               start := false;
               stop := false;
               Scan(bb^.code, tree, op);
               if not kill then
                  if not SameTree(bb^.code, op, tree) then
                     if (op^.left^.opcode <> pc_ldc)
                        or ((op^.left^.optype in [cgByte,cgUByte,cgWord,cgUWord])
                           and (op^.left^.q <> 0))
                        or ((op^.left^.optype in [cgLong,cgULong])
                           and (op^.left^.lval <> 0))
                        or (not (op^.left^.optype in [cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong]))
                        then begin
                        Combine(tree, op);
                        skip := true;
                        end; {if}
               end; {if}
      if not skip then begin		{check for matches in the children}
         if op2 = nil then
	    if tree^.left <> nil then
               op2 := Match(op, tree^.left);
         if op2 = nil then
            if tree^.right <> nil then
               op2 := Match(op, tree^.right);
         end; {if}
      Match := op2;
      end; {Match}


   begin {CheckTree}
   op^.parents := 0;			{zero the parent counter}
   if op^.left <> nil then		{check the children}
      CheckTree(op^.left, bb);
   if op^.right <> nil then
      CheckTree(op^.right, bb);
   if op^.next = nil then		{look for a match to the current code}
      if not (op^.opcode in [pc_cup,pc_cui,pc_tl1,pc_bno,pc_pop,pc_sto,pc_sbf])
         then begin
	 op2 := nil;
	 op3 := bb^.code;
	 while (op2 = nil) and (op3 <> nil) do begin
	    op2 := Match(op, op3);
	    if op2 <> nil then
               if op2^.next = nil then begin
        	  op := op2;
        	  bb := nil;
        	  op3 := nil;
        	  end ;{if}
	    if op3 <> nil then
               op3 := op3^.next;
	    end; {while}
	 end; {if}
   end; {CheckTree}


   procedure CountParents (op: icptr);

   { increment the parent counter for all children of this node	}
   {								}
   { parameters:						}
   {    op - node for which to check the children		}

   begin {CountParents}
   if op^.parents = 0 then begin
      if op^.left <> nil then begin
	 CountParents(op^.left);
	 op^.left^.parents := op^.left^.parents + 1;
	 end; {if}
      if op^.right <> nil then begin
	 CountParents(op^.right);
	 op^.right^.parents := op^.right^.parents + 1;
	 end; {if}
      end; {if}
   end; {CountParents}


   procedure CreateTemps (var op: icptr; bb: blockPtr; var lop: icptr);

   { create temps for nodes with multiple parents		}
   {								}
   { parameters:						}
   {    op - node for which to create temps			}
   {    bb - current basic block				}
   {    lop - predecessor to op					}

   var
      children: boolean;		{does this node have children?}
      llab: integer;			{local label number; for temp}
      op2, str: icptr;			{new opcodes}
      optype: baseTypeEnum;		{type of the temp variable}

   begin {CreateTemps}
   children := false;			{create temps for the children}
   if op^.left <> nil then begin
      children := true;
      CreateTemps(op^.left, bb, lop);
      end; {if}
   if op^.right <> nil then begin
      children := true;
      CreateTemps(op^.right, bb, lop);
      end; {if}
   if children then
      if op^.parents > 1 then begin
         optype := TypeOf(op);		{create a temp label}
         llab := GetTemp(bb, TypeSize(optype));
					{make a copy of the duplicated tree}
         op2 := pointer(Calloc(sizeof(intermediate_code)));
         op2^ := op^;
         op^.opcode := pc_lod;		{substitute a load of the temp}
         op^.optype := optype;
         op^.parents := 1;
         op^.r := llab;
         op^.q := 0;
         op^.left := nil;
         op^.right := nil;
					{store the temp result}
         str := pointer(Calloc(sizeof(intermediate_code)));
         str^.opcode := pc_str;
         str^.optype := optype;
         str^.r := llab;
         {str^.q := 0;}
         str^.left := op2;
         if lop = nil then begin	{insert the store in the basic block}
            str^.next := bb^.code;
            bb^.code := str;
            end {if}
         else begin
            str^.next := lop^.next;
            lop^.next := str;
            end; {else}
         lop := str;
         end; {if}
   end; {CreateTemps}


begin {CommonSubexpressionElimination}
temps := nil;				{no temps allocated, yet}
repeat					{identify common parts}
   done := true;
   bb := DAGblocks;
   while bb <> nil do begin
      Spin;
      op := bb^.code;
      if op <> nil then begin
	 CheckTree(bb^.code, bb);
	 while op^.next <> nil do begin
            CheckTree(op^.next, bb);
            if op^.next <> nil then
	       op := op^.next;
	    end; {while}
	 end; {if}
      bb := bb^.next;
      end; {while}
until done;
bb := DAGblocks;			{count the number of parents}
while bb <> nil do begin
   op := bb^.code;
   Spin;
   while op <> nil do begin
      CountParents(op);
      op := op^.next;
      end; {while}
   bb := bb^.next;
   end; {while}
bb := DAGblocks;			{check for blocked instructions}
while bb <> nil do begin
   op := bb^.code;
   Spin;
   while op <> nil do begin
      CheckForBlocks(op);
      op := op^.next;
      end; {while}
   bb := bb^.next;
   end; {while}
bb := DAGblocks;			{create temps for common subexpressions}
while bb <> nil do begin
   op := bb^.code;
   lop := nil;
   ResetTemps;
   Spin;
   while op <> nil do begin
      CreateTemps(op, bb, lop);
      lop := op;
      op := op^.next;
      end; {while}
   bb := bb^.next;
   end; {while}
DisposeTemps;				{get rid of the temp variable list}
end; {CommonSubexpressionElimination}

{- Loop Optimizations ------------------------------------------}

procedure AddOperation (op: icptr; var lp: iclist);

{ Add an operation to an operation list				}
{								}
{ parameters:							}
{    op - operation to add					}
{    lp - list to add the operation to				}

var
   inList: boolean;			{is op already in the list?}
   llp: iclist;				{work pointer}

begin {AddOperation}
llp := lp;
inList := false;
while llp <> nil do
   if MatchLoc(llp^.op, op) then begin
      inList := true;
      llp := nil;
      end {if}
   else
      llp := llp^.next;
if not inList then begin
   new(llp);
   llp^.next := lp;
   lp := llp;
   llp^.op := op;
   end; {if}
end; {AddOperation}


procedure DisposeBlkList (var blk: blockListPtr);

{ dispose of all entries in the block list			}
{								}
{ parameters:							}
{    blk - list of blocks to dispose of				}

var
   bk1, bk2: blockListPtr;		{work pointers}

begin {DisposeBlkList}
bk1 := blk;
blk := nil;
while bk1 <> nil do begin
   bk2 := bk1;
   bk1 := bk2^.next;
   dispose(bk2);
   end; {while}
end; {DisposeBlkList}


procedure DisposeOpList (var oplist: iclist);

{ dispose of all entries in the list				}
{								}
{ parameters:							}
{    oplist - operation list to dispose of			}

var
   op1, op2: iclist;			{work pointers}

begin {DisposeOpList}
op1 := oplist;
oplist := nil;
while op1 <> nil do begin
   op2 := op1;
   op1 := op2^.next;
   dispose(op2);
   end; {while}
end; {DisposeOpList}


procedure DumpLoopLists;

{ dispose of lists created by ReachingDefinitions and Dominators}

var
   bb: blockPtr;			{used to trace basic block list}
   dom: blockListPtr;			{used to dispose of a dominator}
   
begin {DumpLoopLists}
bb := DAGBlocks;
while bb <> nil do begin
   DisposeOpList(bb^.c_in);		{dump the reaching definition lists}
   DisposeOpList(bb^.c_out);
   DisposeOpList(bb^.c_gen);
   DisposeBlkList(bb^.dom);
   while bb^.dom <> nil do begin	{dump the dominator lists}
      dom := bb^.dom;
      bb^.dom := dom^.next;
      dispose(dom);
      end; {while}
   bb := bb^.next;
   end; {while}
end; {DumpLoopLists}


procedure AddLoads (jp: icptr; var lp: iclist);

{ Add any load addresses from the children of this		}
{ operation							}
{								}
{ parameters:							}
{    jp - operation to check					}
{    lp - list to add the loads to				}

begin {AddLoads}
if jp^.opcode in [pc_lda,pc_lao,pc_lod,pc_lod] then
   AddOperation(jp, lp)
else begin
   if jp^.left <> nil then
      AddLoads(jp^.left, lp);
   if jp^.right <> nil then
      AddLoads(jp^.right, lp);
   end {else}
end; {AddLoads}


procedure FlagIndirectUses;

{ Find all variables that could be changed by an indirect	}
{ access.							}

var
   bb: blockPtr;			{used to trace block list}


   procedure Check (op: icptr; doingInd: boolean);

   { Check op and its children & followers for dangerous	}
   { references							}
   {								}
   { parameters:						}
   {    op - operation to check					}
   {    doingInd - are we doing a pc_ind?  If so, pc_lda's	}
   {       are safe						}

   var
      lDoingInd: boolean;		{local doingInd}

   begin {Check}
   while op <> nil do begin
      if op^.opcode = pc_ind then
         lDoingInd := true
      else
         lDoingInd := doingInd;
      if op^.left <> nil then
         Check(op^.left, lDoingInd);
      if op^.right <> nil then
         Check(op^.right, lDoingInd);
      if op^.opcode in [pc_lao,pc_cpo,pc_ldo,pc_sro,pc_gil,pc_gli,
         pc_gdl,pc_gld] then
         AddOperation(op, c_ind)
      else if op^.opcode = pc_ind then begin
         if op^.left^.opcode = pc_ind then
            AddLoads(op^.left^.left, c_ind);
         end {else if}
      else if op^.opcode = pc_lda then
         if not doingInd then
            AddOperation(op, c_ind);
      op := op^.next;
      end; {while}
   end; {Check}


begin {FlagIndirectUses}
c_ind := nil;
bb := DAGBlocks;
while bb <> nil do begin
   Check(bb^.code, false);
   bb := bb^.next;
   end; {while}
end; {FlagIndirectUses}


procedure DoLoopOptimization;

{ Perform optimizations related to loops and data flow		}

type
   dftptr = ^dftrecord;			{depth first tree edges}
   dftrecord = record
      next: dftptr;
      from, dest: blockPtr;
      end;

var
   backEdge: dftptr;			{list of back edges}
   dft: dftptr;				{depth first tree}
   dft2: dftptr;			{work pointer}


   function DFN (i: integer): blockPtr;

   { find the basic block with dfn index of i			}
   {								}
   { parameters:						}
   {    i - index to look for					}
   {								}
   { Returns: block pointer, or nil if there is none		}

   var
      bb: blockPtr;			{used to trace block list}

   begin {DFN}
   bb := DAGBlocks;
   DFN := nil;
   while bb <> nil do begin
      if bb^.dfn = i then begin
         DFN := bb;
         bb := nil;
         end
      else
         bb := bb^.next;
      end; {while}
   end; {DFN}


   function MemberDFNList (dfn: integer; bl: blockListPtr): boolean;

   { See if dfn is a member of the list bl			}
   {								}
   { parameters:						}
   {    dfn - block number to check				}
   {    bl - list of block numbers to check			}
   {								}
   { Returns: True if dfn is in bl, else false.			}

   begin {MemberDFNList}
   MemberDFNList := false;
   while bl <> nil do
      if bl^.dfn = dfn then begin
         MemberDFNList := true;
         bl := nil;
         end {if}
      else
         bl := bl^.next;
   end; {MemberDFNList}


   function FindDAG (q: integer): blockPtr;

   { Find the DAG containing label q				}
   {								}
   { parameters:						}
   {    q - label to find					}
   {								}
   { Returns: pointer to the proper basic block			}

   var
      bb: blockPtr;			{used to trace basic block list}

   begin {FindDAG}
   bb := DAGBlocks;
   FindDAG := nil;
   while bb <> nil do begin
      if bb^.code^.opcode = dc_lab then
         if bb^.code^.q = q then begin
            FindDAG := bb;
            bb := nil;
            end; {if}
      if bb <> nil then
         bb := bb^.next;
      end; {while}
   end; {FindDAG}


   procedure DepthFirstOrder;

   { Number the DAG for depth first order			}

   var
      bb: blockPtr;			{used to trace basic block lists}
      i: integer;			{dfn index}


      procedure Search (bb: blockPtr);

      { Search this block					}
      {								}
      { parameters:						}
      {    bb - basic block to search				}

      var
         blk: blockPtr;			{work block}
         ndft: dftptr;			{for new tree entries}
         op: icptr;			{used to trace operation list}


         function NotUnconditional: boolean;

         { See if the block ends with something other than an	}
         { unconditional jump					}
         {							}
         { Returns: True if the block ends with something other	}
         {    than pc_ujp or pc_add, else false			}

         var
            op: icptr;			{used to trace the list}

         begin {NotUnconditional}
         NotUnconditional := true;
         op := bb^.code;
         if op <> nil then begin
            while op^.next <> nil do
               op := op^.next;
            if op^.opcode in [pc_add,pc_ujp] then
               NotUnconditional := false;
            end; {if}
         end; {NotUnconditional}


      begin {Search}
      Spin;
      if bb <> nil then
	 if not bb^.visited then begin
	    bb^.visited := true;
            if NotUnconditional then
               if bb^.next <> nil then begin
                  new(ndft);
                  ndft^.next := dft;
                  dft := ndft;
                  ndft^.from := bb;
                  ndft^.dest := bb^.next;
                  Search(bb^.next);
                  end; {if}
	    op := bb^.code;
	    while op <> nil do begin
               if op^.opcode in [pc_ujp, pc_fjp, pc_tjp, pc_add] then begin
                  blk := FindDAG(op^.q);
                  new(ndft);
                  if blk^.visited then begin
                     ndft^.next := backEdge;                        
                     backEdge := ndft;
                     end {if}
                  else begin
                     ndft^.next := dft;
                     dft := ndft;
        	     Search(blk);
                     end; {else}
                  ndft^.from := bb;
                  ndft^.dest := blk;
                  end; {if}
               op := op^.next;
               end; {while}
            bb^.dfn := i;
            i := i-1;
            end; {if}
      end; {Search}


   begin {DepthFirstOrder}
   dft := nil;
   backEdge := nil;
   i := 0;
   bb := DAGblocks;
   while bb <> nil do begin
      bb^.visited := false;
      i := i+1;
      bb := bb^.next;
      end; {while}
   Search(DAGBlocks);
   if i <> 0 then begin                 {ensure DFNs start from 1}
      bb := DAGblocks;
      while bb <> nil do begin
         if bb ^.dfn <> 0 then
            bb^.dfn := bb^.dfn - i;
         bb := bb^.next;
         end; {while}
      end; {if}
   end; {DepthFirstOrder}


   procedure AddDominator (var dom: blockListPtr; dfn: integer);

   { Add dfn to the list of dominators				}
   {								}
   { parameters:						}
   {    dom - dominator list					}
   {    dfn - new dominator number				}

   var
      dp: blockListPtr;			{new node}

   begin {AddDominator}
   new(dp);
   dp^.last := nil;
   dp^.next := dom;
   if dom <> nil then
      dom^.last := dp;
   dom := dp;
   dp^.dfn := dfn;
   end; {AddDominator}
      

   procedure Dominators;

   { Find a list of dominators for each node			}

   var
      bb: blockPtr;			{used to trace the block list}
      change: boolean;			{for loop termination test}
      i, j: integer;			{loop variables}
      maxdfn, mindfn: integer;		{max and min dfn values used}


      procedure CheckPredecessors (bb: blockPtr; bl: dftptr);

      { Eliminate nodes that don't dominate a predecessor	}
      {								}
      { parameters:						}
      {    bb - block being checked				}
      {    bl - list of edges to check for predecessors		}

      var
         dp: blockListPtr;		{list of dominator numbers}
         tdp: blockListPtr;		{used to remove a dominator entry}

      begin {CheckPredecessors}
      while bl <> nil do begin
         if bl^.dest = bb then begin
            dp := bb^.dom;
            while dp <> nil do
               if dp^.dfn <> bb^.dfn then
                  if not MemberDFNList(dp^.dfn, bl^.from^.dom) then begin
                     change := true;
                     tdp := dp;
                     if tdp^.last = nil then
                        bb^.dom := tdp^.next
                     else
                        tdp^.last^.next := tdp^.next;
                     if tdp^.next <> nil then
                        tdp^.next^.last := tdp^.last;
                     dp := tdp^.next;
                     dispose(tdp);
                     end {if}
                  else
                     dp := dp^.next
               else
                  dp := dp^.next;
            end; {if}
         bl := bl^.next;
         end; {while}
      end; {CheckPredecessors}


   begin {Dominators}
   Spin;
   maxdfn := 0;				{find the largest dfn}
   bb := DAGBlocks;
   while bb <> nil do begin
      if bb^.dfn > maxdfn then
         maxdfn := bb^.dfn;
      bb := bb^.next;
      end; {while}
   AddDominator(DAGBlocks^.dom, DAGBlocks^.dfn); {the first node is it's own dominator}
   mindfn := DAGBlocks^.dfn;		{assume all other nodes are dominated by every other node}
   for i := mindfn+1 to maxdfn do begin
      bb := DFN(i);
      if bb <> nil then
         for j := mindfn to maxdfn do
            AddDominator(bb^.dom, j);
      end; {for}
   repeat				{iterate to the true set of dominators}
      change := false;
      for i := mindfn+1 to maxdfn do begin
         bb := DFN(i);
         CheckPredecessors(bb, dft);
         CheckPredecessors(bb, backEdge);
         end; {for}
   until not change;
   end; {Dominators}


   procedure ReachingDefinitions;

   { find the list of reaching definitions for each basic block	}

   var
      bb: blockPtr;			{block being scanned}
      change: boolean;			{loop termination test}
      i: integer;			{node index number}
      newIn: iclist;			{list of inputs}


      function Gen (op: icptr): iclist;

      { find a list of generated values				}
      {								}
      { parameters:						}
      {    op - list of intermediate codes to scan		}
      {								}
      { Returns: list of generated definitions			}

      var
         gp: iclist;			{list of generated definitions}
         indFound: boolean;		{has an indirect store been found?}


         procedure Check (ip: icptr);

         { Add any result from ip to gp				}
         {							}
         { parameters:						}
         {    ip - instruction to check				}

         var
            lc_ind: iclist;		{used to trace the c_ind list}

         begin {Check}
         if ip^.left <> nil then
            Check(ip^.left);
         if ip^.right <> nil then
            Check(ip^.right);
         if ip^.opcode in
            [pc_str,pc_sro,pc_cop,pc_cpo,pc_lli,pc_lil,pc_lld,pc_ldl,
             pc_gli,pc_gil,pc_gld,pc_gdl] then
            AddOperation(ip, gp)
         else if ip^.opcode in [pc_mov,pc_sto,pc_cpi,pc_iil,pc_ili,pc_idl,pc_ild] then
            AddLoads(ip, gp);
         if not indFound then
            if ip^.opcode in
               [pc_sto,pc_cpi,pc_iil,pc_ili,pc_idl,pc_ild,pc_cup,pc_cui,pc_tl1]
                then begin
               lc_ind := c_ind;
               while lc_ind <> nil do begin
                  AddOperation(lc_ind^.op, gp);
                  lc_ind := lc_ind^.next;
                  end; {while}
               indFound := true;
               end; {if}
         end; {Check}                                         


      begin {Gen}
      indFound := false;
      gp := nil;
      while op <> nil do begin
         Check(op);
         op := op^.next;
         end; {while}
      Gen := gp;
      end; {Gen}


      function EqualSets (l1, l2: iclist): boolean;

      { See if two sets of stores and copies are equivalent	}
      {								}
      { parameters:						}
      {    l1, l2 - lists of copies and stores			}
      {								}
      { Returns: True if the lists are equivalent, else false	}
      {								}
      { Notes: The members of each list are assumed to be	}
      {    unique within that list.				}

      var
         c1, c2: integer;		{number of elements in the sets}
         l3: iclist;			{used to trace the lists}
         matchFound: boolean;		{was a match found?}

      begin {EqualSets}
      EqualSets := false;		{assume they are not equal}
      c1 := 0;				{count the elements of l1}
      l3 := l1;
      while l3 <> nil do begin
         c1 := c1+1;
         l3 := l3^.next;
         end; {while}
      c2 := 0;				{count the elements of l2}
      l3 := l2;
      while l3 <> nil do begin
         c2 := c2+1;
         l3 := l3^.next;
         end; {while}
      if c1 = c2 then begin		{make sure each member of l1 is in l2}
         EqualSets := true;
         while l1 <> nil do begin
            matchFound := false;
            l3 := l2;
            while l3 <> nil do begin
               if MatchLoc(l1^.op, l3^.op) then begin
                  l3 := nil;
                  matchFound := true;
                  end {if}
               else
                  l3 := l3^.next;
               end; {while}
            if not matchFound then begin
               EqualSets := false;
               l1 := nil;
               end {if}
            else
               l1 := l1^.next;
            end; {while}
         end; {if}
      end; {EqualSets}


      function Union (l1, l2: iclist): iclist;

      { Returns a list that is the union of two input lists	}
      {								}
      { parameters:						}
      {    l1, l2 - lists					}
      {								}
      { Returns: New, dynamically allocated list that includes	}
      {    all of the members in l1 and l2.			}
      {								}
      { Notes:							}
      {    1.  If there are duplicates, the member from l1 is	}
      {        returned.					}
      {    2.  It is assumed that all members of l1 and l2 are	}
      {        unique within their own list.			}
      {    3.  The original lists are not disturbed.		}
      {    4.  The caller is responsible for disposing of the	}
      {        memory used by the list.				}

      var
         lp: iclist;			{new list pointer}
         np: iclist;			{new list member pointer}
         tp: iclist;			{temp list pointer}

      begin {Union}
      lp := nil;
      tp := l1;
      while tp <> nil do begin
         new(np);
         np^.next := lp;
         lp := np;
         np^.op := tp^.op;
         tp := tp^.next;
         end; {while}
      while l2 <> nil do begin
         if not Member(l2^.op, l1) then begin
            new(np);
            np^.next := lp;
            lp := np;
            np^.op := l2^.op;
            end; {if}
         l2 := l2^.next;
         end; {while}
      Union := lp;
      end; {Union}


      function UnionOfPredecessors (bptr: blockPtr): iclist;

      { create a union of the outputs of predecessors to bptr	}
      {								}
      { parameters:						}
      {    bptr - block for which to look for predecessors	}
      {								}
      { Returns: Resulting set					}

      var
         bp: dftptr;			{used to trace edge lists}
         plist: iclist;			{result list}
         tlist: iclist;			{temp result list}

      begin {UnionOfPredecessors}
      plist := nil;
      bp := dft;
      while bp <> nil do begin
         if bp^.dest = bptr then begin
            tlist := Union(plist, bp^.from^.c_out);
            DisposeOpList(plist);
            plist := tlist;
            end; {if}
         bp := bp^.next;
         end; {while}
      bp := backEdge;
      while bp <> nil do begin
         if bp^.dest = bptr then begin
            tlist := Union(plist, bp^.from^.c_out);
            DisposeOpList(plist);
            plist := tlist;
            end; {if}
         bp := bp^.next;
         end; {while}
      UnionOfPredecessors := plist;
      end; {UnionOfPredecessors}


   begin {ReachingDefinitions}
   i := 1;				{initialize the lists}
   repeat
      bb := DFN(i);
      if bb <> nil then begin
         bb^.c_in := nil;
         bb^.c_gen := Gen(bb^.code);
         bb^.c_out := Union(nil, bb^.c_gen);
         end; {if}
      i := i+1;
   until bb = nil;
   repeat				{iterate to a solution}
      change := false;
      i := 1;
      repeat
	 Spin;
         bb := DFN(i);
         if bb <> nil then begin
            newIn := UnionOfPredecessors(bb);
            if not EqualSets(bb^.c_in, newIn) then begin
               {IN[n] := newIn}
               DisposeOpList(bb^.c_in);
               bb^.c_in := newIn;
               newIn := nil;
               {OUT[n] := IN[n] - KILL[n] U GEN[n]}
               DisposeOpList(bb^.c_out);
               bb^.c_out := Union(bb^.c_in, nil);
               change := true;
               end; {if}
            DisposeOpList(newIn);
            end; {if}
         i := i+1;
      until bb = nil;
   until not change;
   end; {ReachingDefinitions}


   procedure LoopInvariantRemoval;

   { Remove all loop invariant computations			}

   type
      loopPtr = ^loopRecord;		{blocks in a list}
      loopRecord = record
	 next: loopPtr;			{next entry}
	 block: blockPtr;		{code block}
         exit: boolean;			{is this a loop exit?}
	 end;

      loopListPtr = ^loopListRecord;	{list of loop lists}
      loopListRecord = record
	 next: loopListPtr;
	 loop: loopPtr;
	 end;

   var
      icount: integer;			{order invariant found}
      loops: loopListPtr;		{list of loops}
      lp: loopPtr;			{used to trace loop lists}
      llp: loopListPtr;			{used to trace the list of loops}
      fakeDFN: integer;			{to uniquely number newly-created blocks}


      function InLoop (blk: blockPtr; lp: loopPtr): boolean;

      { See if the block is in the loop				}
      {								}
      { parameters:						}
      {    blk - block to check for				}
      {    lp - loop list					}
      {								}
      { Returns: True if blk is in the list, else false		}

      begin {InLoop}
      InLoop := false;
      while lp <> nil do begin
         if lp^.block = blk then begin
            lp := nil;
            InLoop := true;
            end {if}
         else
            lp := lp^.next;
         end; {while}
      end; {InLoop}


      procedure FindLoops;

      { Create a list of the natural loops			}

      var
         blk: blockPtr;			{target block for a jump}
	 bp: dftptr;			{used to trace the back edges}
         lp, lp2: loopPtr;		{used to reverse the list}
	 llp: loopListPtr;		{loop list header entry}
	 llp2: loopListPtr;		{used to reverse the list}
         op: icptr;			{used to trace the opcode list}


	 procedure Add (block: blockPtr);

	 { Add a block to the current loop list				}
	 {								}
	 { parameters:							}
	 {    block - block to add					}

	 var
            lp: loopPtr;			{new loop entry}

	 begin {Add}
	 new(lp);
	 lp^.next := llp^.loop;
	 llp^.loop := lp;
	 lp^.block := block;
         lp^.exit := false;
	 end; {Add}


	 procedure Insert (block: blockPtr);

	 { Insert a block into the loop list				}
	 {								}
	 { parameters:							}
	 {    block - block to add					}


            procedure AddPredecessors (block: blockPtr; bl: dftptr);

            { add any predecessors to the loop				}
            {								}
            { parameters:						}
            {    block - block for which to check for			}
            {       predecessors					}
            {    bl - list of edges to check				}

            begin {AddPredecessors}
            while bl <> nil do begin
               if bl^.dest = block then
        	  Insert(bl^.from);
               bl := bl^.next;
               end; {while}
            end; {AddPredecessors}


	 begin {Insert}
	 if not InLoop(block, llp^.loop) then begin
            Add(block);
            AddPredecessors(block, dft);
            AddPredecessors(block, backEdge);
            end; {if}
	 end; {Insert}


      begin {FindLoops}
      loops := nil;
      bp := backEdge;			{scan the back edges}
      while bp <> nil do begin
	 if MemberDFNList(bp^.dest^.dfn, bp^.from^.dom) then begin
            new(llp);			{create a new loop list entry}
            llp^.next := loops;
            loops := llp;
            llp^.loop := nil;
            Add(bp^.dest);
            Insert(bp^.from);
            lp := llp^.loop;		{reverse the list}
            llp^.loop := nil;
            while lp <> nil do begin
               lp2 := lp;
               lp := lp2^.next;
               lp2^.next := llp^.loop;
               llp^.loop := lp2;
               end; {while}
            lp := llp^.loop;		{mark the exits}
            while lp <> nil do begin
               op := lp^.block^.code;
               while op <> nil do begin
        	  if op^.opcode in [pc_ujp, pc_fjp, pc_tjp, pc_add] then begin
                     blk := FindDAG(op^.q);
                     if not InLoop(blk, llp^.loop) then
                        lp^.exit := true;
                     if op^.opcode in [pc_fjp,pc_tjp] then
                        if not InLoop(lp^.block^.next, llp^.loop) then
                           lp^.exit := true;
                     end; {if}
                  op := op^.next;                        
                  end; {while}
               lp := lp^.next;
               end; {while}
            end; {if}
	 bp := bp^.next;
	 end; {while}
      llp := loops;			{reverse the loop list}
      loops := nil;
      while llp <> nil do begin
	 llp2 := llp;
	 llp := llp2^.next;
	 llp2^.next := loops;
	 loops := llp2;
	 end; {while}
      end; {FindLoops}


      function MarkInvariants (lp: loopPtr): boolean;

      { Make a pass over the opcodes, marking those that are	}
      { invariant.						}
      {								}
      { parameters:						}
      {    lp - loop to scan					}
      {								}
      { Returns: True if any new nodes were marked, else false.	}

      var
         count: integer;		{number of generating blocks}
         indirectStores: boolean;	{does the loop contain indirect stores or function calls?}
         inhibit: boolean;		{inhibit stores?}
         lp2: loopPtr;			{used to trace the loop}
         op: icptr;			{used to trace the instruction list}
         opcode: pcodes;		{op^.opcode; for efficiency}


         procedure Check (op: icptr; olp: loopPtr);

         { See if this node or its children is invariant		}
         {								}
         { parameters:							}
         {    op - node to check					}
         {    olp - loop entry for the block containing the store	}

         var
            invariant: boolean;		{are the operands invariant?}


            function IndirectInhibit (op: icptr): boolean;

            { See if a store should be inhibited due to indirect	}
            { accesses							}
            {								}
            { parameters:						}
            {    op - instruction to check				}
            {								}
            { Returns: True if the instruction should be inhibited,	}
            {    else false.						}

            begin {IndirectInhibit}
            IndirectInhibit := false;
            if indirectStores then
               if Member(op, c_ind) then
                  IndirectInhibit := true;
            end; {IndirectInhibit}


            function NoOtherStoresOrUses (lp, olp: loopPtr; op: icptr): boolean;

            { Check for invalid stores					}
            {								}
            { parameters:						}
            {    lp - loop to check					}
            {    olp - loop entry for the block containing the store	}
            {    op - store to check					}
            {								}
            { Returns: True if the store is valid, false if not.	}
            {								}
            { Notes: Specifically, these two rules are enforced:	}
            {    1. No other stores to the same location appear in the	}
            {       loop.						}
            {    2. All uses of the value in the loop can be reached	}
            {       only by the assign.					}

            var
               lp2: loopPtr;			{used to trace the loop list}
               op2: icptr;			{used to trace code list}


               function SafeLoad (sop, lop: icptr; sbk, lbk: blockPtr): boolean;

               { See if a load is in a safe position			}
               {							}
               { parameters:						}
               {    sop - save opcode that may need to be left in loop	}
               {    lop - load operation that may inhibit the save	}
               {    sbk - block containing the save			}
               {    lbk - block containing the load			}


                  function First (op1, op2, stream: icptr): icptr;

                  { See which operation comes first				}
                  {								}
                  { parmeters:							}
                  {    op1, op2 - instructions to check				}
                  {    stream - start of block containing the instructions	}
                  {								}
                  { Returns: First operation found, or nil if missing		}

                  var
                     op: icptr;				{temp opcode}

                  begin {First}
                  if stream = op1 then
                     First := op1
                  else if stream = op2 then
                     First := op2
                  else begin
                     op := nil;
                     if stream^.left <> nil then
                        op := First(op1, op2, stream^.left);
                     if op = nil then
                        if stream^.right <> nil then
                           op := First(op1, op2, stream^.right);
                     if op = nil then
                        if stream^.next <> nil then
                           op := First(op1, op2, stream^.next);
                     First := op;
                     end; {else}     
                  end; {First}


               begin {SafeLoad}
               if sbk = lbk then
                  SafeLoad := First(sop, lop, sbk^.code) = sop
               else
                  SafeLoad := MemberDFNList(sbk^.dfn, lbk^.dom);
               end; {SafeLoad}


               function MatchStores (op, tree: icptr; opbk, treebk: blockPtr):
                  boolean;

               { Check the tree for stores to the same location as op	}
               {							}
               { parameters:						}
               {    op - store to check for				}
               {    tree - operation tree to check			}
               {    opbk - block containing op				}
               {    treebk - block containing tree			}
               {							}
               { Returns: True if there are matching stores, else false	}

               var
                  result: boolean;		{function result}

               begin {MatchStores}
               result := false;
               if tree^.opcode in [pc_lli,pc_lil,pc_lld,pc_ldl,pc_str,pc_cop,
                  pc_sro,pc_cpo,pc_gli,pc_gil,pc_gld,pc_gdl] then begin
                  if tree <> op then 
                     result := MatchLoc(op, tree);
                  end {if}
               else if tree^.opcode in [pc_ldo,pc_lod] then
                  if MatchLoc(op, tree) then
                     result := not SafeLoad(op, tree, opbk, treebk);
               if not result then
                  if tree^.left <> nil then
                     result := MatchStores(op, tree^.left, opbk, treebk);
               if not result then
                  if tree^.right <> nil then
                     result := MatchStores(op, tree^.right, opbk, treebk);
               MatchStores := result;
               end; {MatchStores}


            begin {NoOtherStoresOrUses}
            NoOtherStoresOrUses := true;
            lp2 := lp;
            while lp2 <> nil do begin
               op2 := lp2^.block^.code;
               while op2 <> nil do
                  if MatchStores(op, op2, olp^.block, lp2^.block) then begin
                     op2 := nil;
                     lp2 := nil;
                     NoOtherStoresOrUses := false;
                     end {if}
                  else
                     op2 := op2^.next;
               if lp2 <> nil then
                  lp2 := lp2^.next;
               end; {while}
            end; {NoOtherStoresOrUses}


            function NumberOfGens (op: icptr; lp: loopPtr): integer;

            { Count the number of nodes that generate op		}
            {								}
            { parameters:						}
            {    op - instruction to check				}
            {    lp - loop to check					}

            var
               count: integer;			{number of generators}

            begin {NumberOfGens}
            count := 0;
            while lp <> nil do begin
               if Member(op, lp^.block^.c_gen) then
                  count := count+1;
               lp := lp^.next;
               end; {while}
            NumberOfGens := count;
            end; {NumberOfGens}


            function PreviousStore (op, list: icptr): boolean;

            { See if the last save was invariant			}
            {								}
            { parameters:						}
            {    op - load operation					}
            {    list - block containing the load			}
            {								}
            { Returns: True if the previous store was invariant, else	}
            {    false.							}

            var
               indop: icptr;			{any indirect operation after strop}
               strop: icptr;			{last matching store before op}


               procedure Check (lop: icptr);

               { Stop if this is lop; save if it is a matching store	}
               {							}
               { parameters:						}
               {    lop - check this operation and it's children	}

               begin {Check}
               if lop^.left <> nil then
                  Check(lop^.left);
               if list <> nil then
                  if lop^.right <> nil then
                     Check(lop^.right);
               if list <> nil then
                  if lop = op then
                     list := nil
                  else if (lop^.opcode in [pc_str,pc_cop,pc_str,pc_cop])
                     and MatchLoc(op, lop) then begin
                     strop := lop;
                     indop := nil;
                     end {else if}
                  else if op^.opcode in
                     [pc_sto,pc_cpi,pc_iil,pc_ili,pc_idl,pc_ild,pc_cup,pc_cui,pc_tl1]
                     then
                     indop := op;
               end; {Check}


               function Inhibit (indop, op: icptr): boolean;

               { See if op should be inhibited due to indirect stores	}
               {							}
               { parameters:						}
               {    indop - inhibiting indirect store or nil		}
               {    op - instruction to check				}

               begin {Inhibit}
               Inhibit := false;
               if indop <> nil then
                  if Member(op, c_ind) then
                     Inhibit := true;
               end; {Inhibit}


            begin {PreviousStore}
            indop := nil;
            strop := nil;
            while list <> nil do begin
               Check(list);
               if list <> nil then
                  list := list^.next;
               end; {while}
            PreviousStore := false;
            if strop <> nil then
               if strop^.parents <> 0 then
                  if not Inhibit(indop, op) then
                     PreviousStore := true;
            end; {PreviousStore}


         begin {Check}
         if op^.parents = 0 then begin
            invariant := true;
            if op^.left <> nil then begin
               Check(op^.left, olp);
               if op^.left^.parents = 0 then
        	  invariant := false;
               end; {if}
            if op^.right <> nil then begin
               Check(op^.right, olp);
               if op^.right^.parents = 0 then
        	  invariant := false;
               end; {if}
            if invariant then begin
               opcode := op^.opcode;
               if opcode in
        	  [pc_adi,pc_adl,pc_adr,pc_and,pc_lnd,pc_bnd,pc_bal,
                   pc_bnt,pc_bnl,pc_bor,pc_blr,pc_bxr,pc_blx,pc_bno,
                   pc_dec,pc_dvi,pc_udi,pc_dvl,pc_udl,pc_dvr,pc_equ,pc_neq,
                   pc_grt,pc_les,pc_geq,pc_leq,pc_inc,pc_ior,pc_lor,
                   pc_ixa,pc_lad,pc_lao,pc_lca,pc_lda,pc_ldc,pc_mod,pc_uim,
                   pc_mdl,pc_ulm,pc_mpi,pc_umi,pc_mpl,pc_uml,pc_mpr,pc_ngi,
                   pc_ngl,pc_ngr,pc_not,pc_pop,pc_sbi,pc_sbl,pc_sbr,
                   pc_shl,pc_sll,pc_shr,pc_usr,pc_slr,pc_vsr,pc_tri,
                   pc_bqr,pc_bqx,pc_baq,pc_bnq,pc_ngq,pc_adq,pc_sbq,
                   pc_mpq,pc_umq,pc_dvq,pc_udq,pc_mdq,pc_uqm,pc_rbo]
                  then begin
        	  op^.parents := icount;
                  icount := icount+1;
                  end {if}
               else if opcode = pc_ind then begin
                  {conservatively assume any indirect stores may alias with op}
                  if not indirectStores then begin
                     op^.parents := icount;
                     icount := icount+1;
                     end; {if}
                  end {else if}
               else if opcode = pc_cnv then begin
        	  if op^.q & $000F <> ord(cgVoid) then begin
        	     op^.parents := icount;
                     icount := icount+1;
                     end; {if}
                  end {else if}
               else if opcode
                  in [pc_sro,pc_sto,pc_str,pc_cop,pc_cpo,pc_cpi]
                  then begin
                  if not inhibit then
                     if not IndirectInhibit(op) then
                	if NoOtherStoresOrUses(lp, olp, op) then begin
        		   op^.parents := icount;
                	   icount := icount+1;
                	   end; {if}
                  end {else if}
               else if opcode in [pc_ldo,pc_lod] then begin
        	  {invariant if there is an immediately preceding invariant store}
        	  if PreviousStore(op, lp2^.block^.code) then begin
                     op^.parents := icount;
                     icount := icount+1;
                     end {if}
        	  else if not Member(op, lp2^.block^.c_gen) then begin
                     {invariant if there are no generators in the loop}
                     count := NumberOfGens(op, lp);
                     if count = 0 then begin
                        op^.parents := icount;       
                        icount := icount+1;
                        end {if}
                     else if count = 1 then begin
                	{invariant if there is one generator AND the generator}
                        {is not in the current block AND no reaching          }
                        {definitions for the loop AND generating statement is }
                        {invariant                                            }
                	if memberOp^.parents <> 0 then
                           if not Member(op, lp^.block^.c_in) then begin
                	      op^.parents := icount;
                	      icount := icount+1;
                              end; {if}
                	end; {else if}
                     end; {else}
        	  end {else if}
               end; {if}
            if op^.parents <> 0 then
               MarkInvariants := true;
            end; {if}
         end; {Check}


         function CheckForIndirectStores (lp: loopPtr): boolean;

         { See if there are any indirect stores or function calls in	}
         { the loop							}
         {								}
         { parameters:							}
         {    lp - loop to check					}
         {								}
         { Returns: True if there are indirect stores or function	}
         {    calls, else false.					}


            function CheckOps (op: icptr): boolean;

            { Check this operation list					}
            {								}
            { parameters:						}
            {    op - operation list to check				}
            {								}
            { Returns: True if an indirect store or function call is	}
            {    found, else false.					}

            var
               result: boolean;			{value to return}

            begin {CheckOps}
            result := false;
            while op <> nil do begin
               if op^.opcode in
                  [pc_sto,pc_cpi,pc_iil,pc_ili,pc_idl,pc_ild,pc_cup,pc_cui,
                   pc_tl1,pc_mov]
                  then begin
                  result := true;
                  op := nil;
                  end {if}
               else begin
                  if op^.left <> nil then
                     result := CheckOps(op^.left);
                  if not result then
                     if op^.right <> nil then
                        result := CheckOps(op^.right);
                  if result then
                     op := nil;
                  end; {if}
               if op <> nil then
                  op := op^.next;
               end; {while}
            CheckOps := result;
            end; {CheckOps}


         begin {CheckForIndirectStores}
         CheckForIndirectStores := false;
         while lp <> nil do
            if CheckOps(lp^.block^.code) then begin
               CheckForIndirectStores := true;
               lp := nil;
               end {if}
            else
               lp := lp^.next;
         end; {CheckForIndirectStores}


         function DominatesExits (dfn: integer; lp: loopPtr): boolean;

         { See if this block dominates all loop exits			}
         {								}
         { parameters:							}
         {    dfn - block that must dominate exits			}
         {    lp - loop list						}
         {								}
         { Returns: True if the block dominates all exits, else false.	}

         var
            dom: blockListPtr;			{used to trace dominator list}

         begin {DominatesExits}
         DominatesExits := true;
         while lp <> nil do begin
            if lp^.exit then begin
               dom := lp^.block^.dom;
               while dom <> nil do 
                  if dom^.dfn = dfn then
                     dom := nil
                  else begin
                     dom := dom^.next;
                     if dom = nil then begin
                        lp := nil;
                        DominatesExits := false;
                        end; {if}
                     end; {else}
               end; {if}
            if lp <> nil then
               lp := lp^.next;
            end; {while}
         end; {DominatesExits}


      begin {MarkInvariants}
      MarkInvariants := false;
      lp2 := lp;
      while lp2 <> nil do begin
         inhibit := not DominatesExits(lp2^.block^.dfn, lp);
         indirectStores := CheckForIndirectStores(lp);
         op := lp2^.block^.code;
         while op <> nil do begin
            Check(op, lp2);
            op := op^.next;
            end; {while}
         lp2 := lp2^.next;
         end; {while}
      end; {MarkInvariants}


      procedure RemoveInvariants (llp: loopListPtr);

      { Remove loop invariant calculations			}
      {								}
      { parameters:						}
      {    llp - pointer to the loop entry to process		}

      var
         icount, oldIcount: integer;	{invariant order counters}
         nhp: blockPtr;			{new loop header pointer}
         ohp: blockPtr;			{old loop header pointer}
         op1, op2, op3: icptr;		{used to reverse the code list}


         procedure CreateHeader;

         { Create the new loop header					}
         {								}
         { Notes: As a side effect, CreateHeader sets nhp to point to	}
         {    the new loop header, and ohp to point to the old header.	}

         var
            lp: loopPtr;			{new loop list entry}

         begin {CreateHeader}
         nhp := pointer(Calloc(sizeof(block)));	{create the new block}
         ohp := llp^.loop^.block;		{insert it in the block list}
         nhp^.last := ohp^.last;
         if nhp^.last <> nil then
            nhp^.last^.next := nhp;
         nhp^.next := ohp;
         ohp^.last := nhp;
         nhp^.dfn := fakeDFN;			{just a unique number, not a real DFN}
         fakeDFN := fakeDFN - 1;
	 new(lp);				{add it to the loop list}
	 lp^.next := llp^.loop;
	 llp^.loop := lp;
	 lp^.block := nhp;
         lp^.exit := false;
         end; {CreateHeader}


         function FindInvariant (ic: integer): integer;

         { Find the next invariant calculation				}
         {								}
         { parameters:							}
         {    ic - base count; the new count must exceed this		}
         {								}
         { Returns: count for the invariant record to remove		}

         var
            lp: loopPtr;			{used to trace loop list}
            op: icptr;				{used to trace code list}
            nic: integer;			{lowest count > ic}


            procedure Check (op: icptr);

            { See if op or its children represent a newer invariant	}
            { calculation than the one numbered nic			}
            {								}
            { parameters:						}
            {    op - instruction to check				}
            {								}
            { Notes: Rejecting pc_bno here is rather odd, but it allows	}
            {    expressions _containing_ pc_bno to be removed without	}
            {    messing up pc_tri operations by allowing pc_bno to be	}
            {    removed as the top level of an expression.		}

            begin {Check}
            if op^.parents = 0 then begin
               if op^.left <> nil then
                  Check(op^.left);
               if op^.right <> nil then
                  Check(op^.right);
               end {if}
            else begin
               if op^.parents < nic then
                  if op^.parents > ic then
                     if op^.opcode <> pc_bno then
                        nic := op^.parents;
               end; {else}
            end; {Check}


         begin {FindInvariant}
         nic := maxint;
         lp := llp^.loop;
         while (lp <> nil) and (nic <> ic+1) do begin
            op := lp^.block^.code;
            while op <> nil do begin
               Check(op);
               op := op^.next;
               end; {while}
            lp := lp^.next;
            end; {while}
         FindInvariant := nic;
         end; {FindInvariant}


         procedure RemoveInvariant (ic: integer);

         { Move the invariant calculation to the header			}
         {								}
         { parameters:							}
         {    ic - index number for instruction to remove		}

         var
            done: boolean;			{loop termination test}
            lp: loopPtr;			{used to trace loop list}
            op: icptr;				{used to trace code list}


            procedure Check (op: icptr);

            { See if a child of op is the target instruction to move	}
            { (If so, move it.)						}
            {								}
            { parameters:						}
            {    op - instruction to check				}


               procedure Remove (var op: icptr);

               { Move a calculation to the loop header			}
               {							}
               { parameters:						}
               {    op - invariant calculation to move			}

               var
		  loc, op2, str: icptr;		{new opcodes}
		  optype: baseTypeEnum;		{type of the temp variable}

               begin {Remove}
               if op^.opcode in [pc_pop,pc_str,pc_sro,pc_sto,pc_sbf] then
                  {do nothing for now - would need special code to move these}
               else if (op^.left <> nil) or (op^.right <> nil) then begin
        	  optype := TypeOf(op);		{create a temp label}
        	  loc := pointer(Calloc(sizeof(intermediate_code)));
        	  loc^.opcode := dc_loc;
        	  loc^.optype := cgWord;
        	  maxLoc := maxLoc + 1;
        	  loc^.r := maxLoc;
        	  loc^.q := TypeSize(optype);
        	  loc^.next := nhp^.code;
        	  nhp^.code := loc;
						{make a copy of the tree}
        	  op2 := pointer(Malloc(sizeof(intermediate_code)));
        	  op2^ := op^;
        	  op^.opcode := pc_lod;		{substitute a load of the temp}
        	  op^.optype := optype;
        	  op^.r := loc^.r;
        	  op^.q := 0;
        	  op^.left := nil;
        	  op^.right := nil;
						{store the temp result}
        	  str := pointer(Calloc(sizeof(intermediate_code)));
        	  str^.opcode := pc_str;
        	  str^.optype := optype;
        	  str^.r := loc^.r;
        	  {str^.q := 0;}
        	  str^.left := op2;
        	  str^.next := loc^.next;	{insert the store in the basic block}
        	  loc^.next := str;
                  end; {else if}
               done := true;
               end; {Remove}


            begin {Check}
            if op^.left <> nil then begin
               if op^.left^.parents = ic then
                  Remove(op^.left);
               if not done then
                  Check(op^.left);
               end; {if}
            if not done then
               if op^.right <> nil then begin
        	  if op^.right^.parents = ic then 
                     Remove(op^.right);
                  if not done then
                     Check(op^.right);
                  end; {if}
            end; {Check}   


            procedure RemoveTop (var op: icptr);

            { Move a top-level instruction to the header		}
            {								}
            { parameters:						}
            {    op - top level instruction to remove			}

            var
               op2: icptr;			{temp operation}

            begin {RemoveTop}
            op2 := op;
            op := op^.next;
            op2^.next := nhp^.code;
            nhp^.code := op2;
            end; {RemoveTop}


         begin {RemoveInvariant}
         lp := llp^.loop;
         done := false;
         while not done do begin
            op := lp^.block^.code;
            if op <> nil then
               if op^.parents = ic then begin
        	  RemoveTop(lp^.block^.code);
        	  done := true;
        	  end {if}
               else begin
        	  Check(op);
        	  while (op^.next <> nil) and (not done) do begin
                     if op^.next^.parents = ic then begin
                	RemoveTop(op^.next);
                	done := true;
                	end {if}
                     else
                	Check(op^.next);
                     if op^.next <> nil then
        		op := op^.next;
        	     end; {while}
        	  end; {else}
            lp := lp^.next;
            if lp = nil then
               done := true;
            end; {while}
         end; {RemoveInvariant}


         procedure AdjustControlFlow;

         { Adjust control flow to account for loop invariant removal.	}
         { The current loop's back edges should go to the old header	}
         { block, bypassing removed invariant computations.  Any other	}
         { jumps to the start of the loop should go to the new header	}
         { block so that those computations are performed.		}

         var
            lp: loopPtr;		{used to trace loop list}
            op, op1: icptr;		{used to trace code list}

         begin {AdjustControlFlow}
         				{move old header label to new header}
         				{(for any jumps to it from outside loop)}
         if (ohp^.code = nil) or (ohp^.code^.opcode <> dc_lab) then
            TermError(3);		{shouldn't happen, but let's be sure}
         op1 := pointer(Calloc(sizeof(intermediate_code)));
         op1^.opcode := dc_lab;
         op1^.q := ohp^.code^.q;
         op1^.next := nhp^.code;
         nhp^.code := op1;

         ohp^.code^.q := GenLabel;	{make new label for old header &}
         lp := llp^.loop;		{adjust loop back edges to go to it}
         while (lp <> nil) do begin
            op := lp^.block^.code;
            while op <> nil do begin
               if op^.opcode in [pc_ujp,pc_fjp,pc_tjp,pc_add] then
                  if op^.q = op1^.q then begin
                     op^.q := ohp^.code^.q;
                     end;
               op := op^.next;
               end; {while}
            lp := lp^.next;
            end; {while}
         end; {AdjustControlFlow}


         procedure UpdateLoopLists;

         { Update not-yet-processed loops to include the new header	}
         { block if appropriate.  Also update any additional loops with	}
         { the same original header to now include all the nodes of the	}
         { loop just processed, since their back edges will now go to	}
         { the new header, which dominates the original header.		}

         var
            lp, lp2, lp3: loopPtr;	{used to trace loop list}

         begin {UpdateLoopLists}
         loops := llp^.next;
         while loops <> nil do begin
            if loops^.loop^.block = ohp then begin
               				{Another loop with the same header.}
               				{Nodes of llp^.loop must be added to it.}
               				{They go after the original header.}
               lp3 := loops^.loop;
               lp := llp^.loop;
               while lp <> nil do begin
                  if lp^.block <> nhp then
                     if not InLoop(lp^.block, loops^.loop) then begin
                        new(lp2);
                        lp2^.next := lp3^.next;
                        lp2^.block := lp^.block;
                        lp2^.exit := lp^.exit;
                        lp3^.next := lp2;
                        lp3 := lp2;
                        end; {if}
                  lp := lp^.next;
                  end; {while}
               end; {if}
            lp := loops^.loop;		{Add nhp to other loops containing ohp}
            while lp <> nil do begin
               if lp^.block = ohp then begin
                  new(lp2);
                  lp2^.next := lp^.next;
                  lp2^.block := lp^.block;
                  lp2^.exit := lp^.exit;
                  lp^.next := lp2;
                  lp^.block := nhp;
                  lp^.exit := false;
                  lp := nil;
                  end {if}
               else
                  lp := lp^.next;
               end; {while}
            loops := loops^.next;
            end; {while}
         end; {UpdateLoopLists}


         procedure UpdateDominators;

         { Set dominators of the new header block, and update		}
         { dominators of other blocks to include it where appropriate.	}

         var
            bb: blockPtr;		{used to trace list of basic blocks}
            dom: blockListPtr;		{used to trace dominator list}

         begin {UpdateDominators}
         dom := ohp^.dom;		{Set dominators of new header block}
         while dom <> nil do begin
            if dom^.dfn <> ohp^.dfn then
               AddDominator(nhp^.dom, dom^.dfn);
            dom := dom^.next;
            end; {while}
         AddDominator(nhp^.dom, nhp^.dfn);

         bb := DAGBlocks;		{Add nhp to other loops' dominators}
         while bb <> nil do begin
            if MemberDFNList(ohp^.dfn, bb^.dom) then
               AddDominator(bb^.dom, nhp^.dfn);
            bb := bb^.next;
            end; {while}
         end; {UpdateDominators}


      begin {RemoveInvariants}
      CreateHeader;			{create a loop header block}
      icount := 0;			{find & remove all invariants}
      repeat
         oldIcount := icount;
         icount := FindInvariant (icount);
         if icount <> maxint then
            RemoveInvariant(icount);
      until icount = maxint;
      op1 := nhp^.code;			{reverse the new code list}
      op2 := nil;
      while op1 <> nil do begin
         op3 := op1;
         op1 := op1^.next;
         op3^.next := op2;
         op2 := op3;
         end; {while}
      nhp^.code := op2;
      					{adjust things to account for changes}
      if nhp^.code <> nil then begin
         Spin;
         AdjustControlFlow;
         UpdateLoopLists;
         UpdateDominators;
         end; {if}
      end; {RemoveInvariants}


      procedure ZeroParents (lp: loopPtr);

      { Zero the parents field in all nodes			}
      {								}
      { parameters:						}
      {    lp - loop for which to zero the parents		}

      var
         op: icptr;			{used to trace the opcode list}


         procedure Zero (op: icptr);

         { Zero the parents field for this node and its		}
         { children.						}
         {							}
         { parameters:						}
         {    op - node to zero					}

         begin {Zero}
         op^.parents := 0;
         if op^.left <> nil then
            Zero(op^.left);
         if op^.right <> nil then
            Zero(op^.right);
         end; {Zero}

            
      begin {ZeroParents}
      while lp <> nil do begin
         op := lp^.block^.code;
         while op <> nil do begin
            Zero(op);
            op := op^.next;
            end; {while}
         lp := lp^.next;
         end; {while}
      end; {ZeroParents}


   begin {LoopInvariantRemoval}
   Spin;
   FindLoops;				{find a list of natural loops}
   fakeDFN := -1;

   llp := loops;			{scan the loops...}
   icount := 1;
   while llp <> nil do begin
      Spin;
      ZeroParents(llp^.loop);		{set the parents field to zero}
      while MarkInvariants(llp^.loop) do {mark the loop invariant computations}
         ;
      if icount <> 1 then
	 RemoveInvariants(llp);		{remove loop invariant calculations}
      llp := llp^.next;
      end; {while}


   while loops <> nil do begin		{dispose of the loop lists}
      while loops^.loop <> nil do begin
	 lp := loops^.loop;
	 loops^.loop := lp^.next;
	 dispose(lp);
	 end; {while}
      llp := loops;
      loops := llp^.next;
      dispose(llp);
      end; {while}
   end; {LoopInvariantRemoval}
   

begin {DoLoopOptimization}
DepthFirstOrder;			{create the depth first tree}
ReachingDefinitions;			{find reaching definitions}
Dominators;				{find the lists of dominators}
LoopInvariantRemoval;			{remove loop invariant computations}
while dft <> nil do begin		{dispose of the depth first tree}
   dft2 := dft;
   dft := dft2^.next;
   dispose(dft2);
   end; {while}
while backEdge <> nil do begin		{dispose of the back edge list}
   dft2 := backEdge;
   backEdge := dft2^.next;
   dispose(dft2);
   end; {while}
end; {DoLoopOptimization}

{---------------------------------------------------------------}

procedure DAG {code: icptr};

{ place an op code in a DAG or tree				}
{                                                               }
{ parameters:                                                   }
{       code - opcode						}

var
   temp: icptr;				{temp node}


   procedure Generate;

   { generate the code for the current procedure		}

   var
      op: icptr;			{temp opcode pointers}


      procedure BasicBlocks;

      { Break the code up into basic blocks			}

      var
         blast: blockPtr;		{last block pointer}
         bp: blockPtr;			{current block pointer}
         cb: icptr;			{last code in block pointer}
         cp: icptr;			{current code pointer}

      begin {BasicBlocks}
      cp := DAGhead;
      DAGblocks := nil;
      if cp <> nil then begin
         bp := pointer(Calloc(sizeof(block)));
         DAGblocks := bp;
         blast := bp;
         bp^.code := cp;
         cb := cp;
         cp := cp^.next;
         cb^.next := nil;
         while cp <> nil do
					{labels start a new block}
            if cp^.opcode = dc_lab then begin
               Spin;
               bp := pointer(Calloc(sizeof(block)));
               bp^.last := blast;
               blast^.next := bp;
               blast := bp;
               bp^.code := cp;
               cb := cp;
               cp := cp^.next;
               cb^.next := nil;
               end {if}
					{conditionals are followed by a new block}
            else if cp^.opcode in [pc_fjp, pc_tjp, pc_ujp, pc_ret, pc_xjp] then
               begin
               Spin;
               while cp^.next^.opcode = pc_add do begin
                  cb^.next := cp;
        	  cb := cp;
        	  cp := cp^.next;
        	  cb^.next := nil;
                  end; {while}
               cb^.next := cp;
               cb := cp;
               cp := cp^.next;
               cb^.next := nil;
               bp := pointer(Calloc(sizeof(block)));
               bp^.last := blast;
               blast^.next := bp;
               blast := bp;
               bp^.code := cp;
               cb := cp;
               cp := cp^.next;
               cb^.next := nil;
               end {else if}
            else begin			{all other statements get added to a block}
               cb^.next := cp;
               cb := cp;
               cp := cp^.next;
               cb^.next := nil;
               end; {else}
         end; {if}
      end; {BasicBlocks}


   begin {Generate}             
   					{peephole optimization}
   if peepHole and not fenvAccessInFunction then
      repeat
         rescan := false;
	 PeepHoleOptimization(DAGhead);
	 op := DAGHead;
	 while op^.next <> nil do begin
	    Spin;
            PeepHoleOptimization(op^.next);
            op := op^.next;
            end; {while}
	 CheckLabels;
      until not rescan;
   BasicBlocks;				{build the basic blocks}
   if commonSubexpression or loopOptimizations then
      if not volatile then
         if not fenvAccessInFunction then
            FlagIndirectUses;		{create a list of all indirect uses}
   if commonSubexpression then		{common sub-expression removal}
      if not volatile then
         if not fenvAccessInFunction then
            CommonSubexpressionElimination;
   if loopOptimizations then		{loop optimizations}
      if not volatile then
         if not fenvAccessInFunction then
            DoLoopOptimization;
{  if printSymbols then			{debug}
{     PrintBlocks(@'DAG: ', DAGblocks);	{debug}
   if commonSubexpression or loopOptimizations then
      if not volatile then
         if not fenvAccessInFunction then
            DisposeOpList(c_ind);	{dispose of indirect use list}
   Gen(DAGblocks);			{generate native code}
   if loopOptimizations then		{dump and dynamic space}
      if not volatile then
         if not fenvAccessInFunction then
            DumpLoopLists;
   DAGhead := nil;			{reset the DAG pointers}
   end; {Generate}
   
   
   procedure CheckReturn;
   
   { Check if a noreturn function looks like it might return,   }
   { or if a non-void function might return with no value.      }
   {                                                            }
   { This uses a heuristic of basically looking for code at the }
   { end of the function that would lead to it returning if     }
   { executed.  Control flow operations are optimistically      }
   { assumed not to lead to a return.  This may produce both    }
   { false positives and false negative, but any false          }
   { positives should reflect extraneous code that is not       }
   { actually reachable (which is dubious in its own right).    }
   
   var
      code: icptr;

   begin {CheckReturn}
   code := DAGhead;
   while code^.opcode in [pc_lnm,dc_lab,dc_loc,pc_add] do
      code := code^.next;
   while code^.opcode = pc_pop do
      code := code^.left;
   while code^.opcode = pc_bno do
      code := code^.right;
   if not (code^.opcode in [pc_fjp,pc_tjp,pc_ujp,pc_xjp,pc_cui,pc_cup,pc_tl1])
      then begin
      if fIsNoreturn then
         Error(154)
      else
         Error(155);
      end;
   end; {CheckReturn}


   procedure Push (code: icptr);

   { place a node on the operation stack			}
   {								}
   { parameters:						}
   {    code - node						}

   begin {Push}
   code^.next := DAGhead;
   DAGhead := code;
   end; {Push}


   function Pop: icptr;

   { pop a node from the operation stack			}
   {								}
   { returns: node pointer or nil				}

   var
      node: icptr;			{node poped}
      tn: icptr;			{temp node}

   begin {Pop}
   node := DAGhead;
   if node = nil then
      Error(cge1)
   else begin
      DAGhead := node^.next;
      node^.next := nil;
      end; {else}
   if node^.opcode = dc_loc then begin
      tn := node;
      node := Pop;
      Push(tn);
      end; {if}
   Pop := node;
   end; {Pop}


   procedure Reverse;

   { Reverse the operation stack				}

   var
      list, temp: icptr;		{work pointers}

   begin {Reverse}
   list := nil;
   while DAGhead <> nil do begin
      temp := DAGhead;
      DAGhead := temp^.next;
      temp^.next := list;
      list := temp;
      end; {while}
   DAGhead := list;
   end; {Reverse}


begin {DAG}
case code^.opcode of

   pc_bnt, pc_bnl, pc_cnv, pc_dec, pc_inc, pc_ind, pc_lbf, pc_lbu,
   pc_ngi, pc_ngl, pc_ngr, pc_not, pc_stk, pc_cop, pc_cpo, pc_tl1,
   pc_sro, pc_str, pc_fjp, pc_tjp, pc_xjp, pc_cup, pc_pop, pc_iil,
   pc_ili, pc_idl, pc_ild, pc_bnq, pc_ngq, pc_rbo:
      begin
      code^.left := Pop;
      Push(code);
      end;

   pc_adi, pc_adl, pc_adr, pc_and, pc_lnd, pc_bnd, pc_bal, pc_bno,
   pc_bor, pc_blr, pc_bxr, pc_blx, pc_cbf, pc_cpi, pc_dvi, pc_mov,
   pc_udi, pc_dvl, pc_udl, pc_dvr, pc_equ, pc_geq, pc_grt, pc_leq,
   pc_les, pc_neq, pc_ior, pc_lor, pc_ixa, pc_mod, pc_uim, pc_mdl,
   pc_ulm, pc_mpi, pc_umi, pc_mpl, pc_uml, pc_mpr, pc_psh, pc_sbi,
   pc_sbl, pc_sbr, pc_shl, pc_sll, pc_shr, pc_usr, pc_slr, pc_vsr,
   pc_tri, pc_sbf, pc_sto, pc_cui, pc_bqr, pc_bqx, pc_baq, pc_adq,
   pc_sbq, pc_mpq, pc_umq, pc_dvq, pc_udq, pc_mdq, pc_uqm, pc_slq,
   pc_sqr, pc_wsr:
      begin
      code^.right := Pop;
      code^.left := Pop;
      Push(code);
      end;

   pc_gil, pc_gli, pc_gdl, pc_gld, pc_lil, pc_lli, pc_ldl, pc_lld,
   pc_lad, pc_lao, pc_lca, pc_lda, pc_ldc, pc_ldo, pc_lod, pc_nop,
   dc_cns, dc_glb, dc_dst, pc_lnm, pc_nam, pc_nat, dc_lab, pc_add,
   pc_ujp, dc_pin, pc_ent, dc_sym, pc_fix:
      Push(code);

   pc_ret:
      begin
      if (lint & lintReturn) <> 0 then
         if fIsNoreturn or ((code^.optype <> cgVoid) and not doingMain) then
            CheckReturn;
      Push(code);
      end;

   pc_cnn:
      begin
      code^.opcode := pc_cnv;
      temp := Pop;
      code^.left := Pop;
      Push(code);
      Push(temp);
      end;

   dc_loc: begin
      Push(code);
      if code^.r > maxLoc then
         maxLoc := code^.r;
      end;

   dc_prm: begin
      Push(code);
      if code^.s > maxLoc then
         maxLoc := code^.s;
      end;

   dc_str: begin
      Push(code);
      maxLoc := 0;
      end;

   dc_enp: begin
      Push(code);
      Reverse;
      Generate;
      end;

   otherwise: Error(cge1);		{invalid opcode}
   end; {case}
end; {DAG}

end.