From ca21e33ba71be2d4289de6121c3b4d3136d0c214 Mon Sep 17 00:00:00 2001
From: Stephen Heumann <stephenheumann@gmail.com>
Date: Tue, 11 Oct 2022 21:14:40 -0500
Subject: [PATCH] Generate more efficient code for indirect function calls.

---
 CGI.pas    |  5 +++--
 Gen.pas    | 59 ++++++++++++++++++++++++++++--------------------------
 Native.pas | 24 ++++++++++++++++++++--
 3 files changed, 56 insertions(+), 32 deletions(-)

diff --git a/CGI.pas b/CGI.pas
index 8b91ab6..7ed8546 100644
--- a/CGI.pas
+++ b/CGI.pas
@@ -37,8 +37,8 @@ const
                                         {65816 native code generation}
                                         {----------------------------}
                                         {instruction modifier flags}
-   shift8                 =      1;     {shift operand left 8 bits}
-   shift16                =      2;     {shift operand left 16 bits}
+   shift8                 =      1;     {shift operand right 8 bits}
+   shift16                =      2;     {shift operand right 16 bits}
    toolCall               =      4;     {generate a tool call}
    stringReference        =      8;     {generate a string reference}
    isPrivate              =     32;     {is the label private?}
@@ -46,6 +46,7 @@ const
    localLab               =    128;     {the operand is a local lab}
    forFlags               =    256;     {instruction used for effect on flags only}
    subtract1              =    512;     {subtract 1 from address operand}
+   shiftLeft8             =   1024;     {shift operand left 8 bits}
 
    m_adc_abs              =    $6D;     {op code #s for 65816 instructions}
    m_adc_dir              =    $65;
diff --git a/Gen.pas b/Gen.pas
index e47e0ac..50710bd 100644
--- a/Gen.pas
+++ b/Gen.pas
@@ -5502,41 +5502,42 @@ procedure GenTree {op: icptr};
    GenTree(op^.left);
 
    {get the address to call}
-   gLong.preference := onStack;
+   gLong.preference := A_X;
    GenTree(op^.right);
-   gLong := lLong;
-   gQuad := lQuad;
-   
-   {For functions returning cg(U)Quad, x = address to store result in}
-   if op^.optype in [cgQuad,cgUQuad] then 
-      if gQuad.preference = localAddress then begin
-         GenImplied(m_tdc);
-         GenImplied(m_clc);
-         GenNative(m_adc_imm, immediate, gQuad.disp, nil, 0);
-         GenImplied(m_tax);
-         end {if}
-      else begin
-         GenImplied(m_tsc);
-         GenImplied(m_clc);
-         GenNative(m_adc_imm, immediate, argsSize+extraStackSize+4+1, nil, 0);
-         GenImplied(m_tax);
-         end; {else}
 
    {create a return label}
    lab1 := GenLabel;
 
    {place the call/return addrs on stack}
-   GenNative(m_lda_s, direct, 1, nil, 0);
-   GenImplied(m_dea);
+   if gLong.where = A_X then begin
+      GenImplied(m_tay);
+      GenImplied(m_txa);
+      end {if}
+   else {if gLong.where = onStack then} begin
+      GenImplied(m_ply);
+      GenImplied(m_pla);
+      end; {else}
+   GenNative(m_and_imm, immediate, $00ff, nil, 0);
+   GenNative(m_ora_imm, genAddress, lab1, nil, subtract1+shiftLeft8);
+   GenNative(m_pea, genAddress, lab1, nil, subtract1+shift8);
    GenImplied(m_pha);
-   GenNative(m_sep, immediate, 32, nil, 0);
-   GenNative(m_lda_s, direct, 5, nil, 0);
-   GenNative(m_sta_s, direct, 3, nil, 0);
-   GenNative(m_lda_imm, genAddress, lab1, nil, shift16);
-   GenNative(m_sta_s, direct, 6, nil, 0);
-   GenNative(m_rep, immediate, 32, nil, 0);
-   GenNative(m_lda_imm, genAddress, lab1, nil, subtract1);
-   GenNative(m_sta_s, direct, 4, nil, 0);
+   GenImplied(m_dey);
+   GenImplied(m_phy);
+
+   {For functions returning cg(U)Quad, x = address to store result in}
+   if op^.optype in [cgQuad,cgUQuad] then 
+      if lQuad.preference = localAddress then begin
+         GenImplied(m_tdc);
+         GenImplied(m_clc);
+         GenNative(m_adc_imm, immediate, lQuad.disp, nil, 0);
+         GenImplied(m_tax);
+         end {if}
+      else begin
+         GenImplied(m_tsc);
+         GenImplied(m_clc);
+         GenNative(m_adc_imm, immediate, argsSize+extraStackSize+6+1, nil, 0);
+         GenImplied(m_tax);
+         end; {else}
 
    {indirect call}
    GenImplied(m_rtl);
@@ -5569,6 +5570,8 @@ procedure GenTree {op: icptr};
       end; {else}
 
    {save the returned value}
+   gLong := lLong;
+   gQuad := lQuad;
    gLong.where := A_X;
    if gQuad.preference = localAddress then
       gQuad.where := localAddress
diff --git a/Native.pas b/Native.pas
index 02134e5..68e5de1 100644
--- a/Native.pas
+++ b/Native.pas
@@ -293,7 +293,7 @@ else begin
       end; {if}
    if shift <> 0 then begin
       Out(129);                         {shift the address}
-      Out2(-shift); Out2(-1);
+      Out2(-shift); if (shift > 0) then Out2(-1) else Out2(0);
       Out(7);
       end; {if}
    if lab <> maxlabel then              {if not a string, end the expression}
@@ -458,6 +458,26 @@ var
    end; {DefGlobal}
 
 
+   function ShiftSize (flags: integer): integer;
+
+   { Determine the shift size specified by flags.               }
+   { (Positive means right shift, negative means left shift.)   }
+   {                                                            }
+   { parameters:                                                }
+   {    flags - the flags                                       }
+
+   begin {ShiftSize}
+   if (flags & shift8) <> 0 then
+      ShiftSize := 8
+   else if (flags & shift16) <> 0 then
+      ShiftSize := 16
+   else if (flags & shiftLeft8) <> 0 then
+      ShiftSize := -8
+   else
+      ShiftSize := 0;
+   end; {ShiftSize}
+
+
 begin {WriteNative}
 { writeln('WriteNative: ',opcode:4, ', mode=', ord(mode):1,
    ' operand=', operand:1);      {debug}
@@ -732,7 +752,7 @@ case mode of
          else
             LabelSearch(operand, 1, 16, 0)
       else if (flags & subtract1) <> 0 then
-         LabelSearch(operand, 0, 0, 0)
+         LabelSearch(operand, 0, ShiftSize(flags), 0)
       else
          LabelSearch(operand, 2, 0, 0);
       end;