# vcg_opt --- simplistic optimizer for code generator

define(KNOWN,0)
define(UNKNOWN,1)

define(FWD(i),Imem(i+1))
define(REV(i),Imem(i+2))

define(UTOL(u),rt(intl(u),16))

# optimize --- optimize procedure definition code
#              This code is NOT general purpose; skip instructions,
#              jumps without label targets, and use of exotic instructions
#              like STLR may cause it to fail.
#              However, it will work on the code presently generated.

   subroutine optimize (code)
   ipointer code

   include VCG_COMMON

   ipointer i, new_i
   ipointer gen_generic

   integer a_state, l_state, f_state, lf_state, x_state, xb_state
   integer aad (ADDR_DESC_SIZE), lad (ADDR_DESC_SIZE),
      fad (ADDR_DESC_SIZE), lfad (ADDR_DESC_SIZE), xad (ADDR_DESC_SIZE),
      xbad (ADDR_DESC_SIZE), frame_state

   logical ad_equal, overlap, link_instr_emitted, proc_instr_emitted

   procedure trash forward
   procedure kill_indexed forward
   procedure kill_xb_rel forward
   procedure kill_address (width) forward
   procedure discard_inst forward

DB call print (ERROUT, "optimize:*n"s)

   frame_state = PROC_INS
   link_instr_emitted = FALSE
   proc_instr_emitted = FALSE

   trash
  # We depend here on the fact that code points to a PROC_INS
  # that will never be changed
   for (i = FWD (code); i ~= code; i = FWD (i)) {

      call simplify (i)    # may change i

      if (Imem (i) == GENERIC_INSTRUCTION){
         if (Imem (i + 3) == LINK_INS) {
            if (frame_state == LINK_INS)
               # delete redundant LINK
               discard_inst
            else if (~proc_instr_emitted) {
               if (Imem (REV (i)) == GENERIC_INSTRUCTION
                  && Imem (REV (i) + 3) == PROC_INS) {
                  # take out preceding PROC & current LINK
                  FWD (REV (REV (i))) = FWD (REV (i))
                  REV (i) = REV (REV (i))
                  discard_inst
                  }
               else
                  link_instr_emitted = FALSE
               frame_state = LINK_INS
               }
            else { # just switch frames
               frame_state = LINK_INS
               link_instr_emitted = FALSE
               }
            }
         else if (Imem (i + 3) == PROC_INS) {
            if (frame_state == PROC_INS)
               # delete redundant PROC
               discard_inst
            else if (~link_instr_emitted) {
               if (Imem (REV (i)) == GENERIC_INSTRUCTION
                  && Imem (REV (i) + 3) == LINK_INS) {
                  # take out preceding LINK & current PROC
                  FWD (REV (REV (i))) = FWD (REV (i))
                  REV (i) = REV (REV (i))
                  discard_inst
                  }
               else
                  proc_instr_emitted = FALSE
               frame_state = PROC_INS
               }
            else { # just switch frames
               frame_state = PROC_INS
               proc_instr_emitted = FALSE
               }
            }
         else {
            if (frame_state == PROC_INS)
               proc_instr_emitted = TRUE
            else
               link_instr_emitted = TRUE
            }
         }
      else {
         if (frame_state == PROC_INS)
            proc_instr_emitted = TRUE
         else
            link_instr_emitted = TRUE
         }

      select (Imem (i))

         when (BRANCH_INSTRUCTION)
                ; # no effect under present conditions

         when (LABEL_INSTRUCTION)
            trash

         when (GENERIC_INSTRUCTION) {
            select (Imem (i + 3))
               when (A1A_INS, A2A_INS, CAL_INS, CAR_INS, CHS_INS,
                 CMA_INS, CSA_INS, IAB_INS, ICA_INS, ICR_INS, INTA_INS,
                 LCEQ_INS, LCGE_INS, LCGT_INS, LCLE_INS, LCLT_INS,
                 LCNE_INS, LEQ_INS, LFEQ_INS, LFGE_INS, LFGT_INS,
                 LFLE_INS, LFLT_INS, LFNE_INS, LGE_INS, LGT_INS,
                 LLE_INS, LLEQ_INS, LLGE_INS, LLGT_INS, LLLE_INS,
                 LLLT_INS, LLNE_INS, LLT_INS, LNE_INS, S1A_INS,
                 S2A_INS, SSM_INS, SSP_INS, TBA_INS, TCA_INS,
                 TKA_INS, TYA_INS, XCB_INS,
                 ICL_INS, ILE_INS, INTL_INS, PIDA_INS, PIDL_INS,
                 PIMA_INS, PIML_INS, STEX_INS, TCL_INS, TFLL_INS) {
                  a_state = UNKNOWN
                  l_state = UNKNOWN
                  }
               when (CRA_INS, LF_INS) {
                  if (a_state == KNOWN && AD_MODE (aad) == ILIT_AM
                    && AD_LIT1 (aad) == 0)
                     discard_inst
                  else {
                     a_state = KNOWN
                     AD_MODE (aad) = ILIT_AM
                     AD_LIT1 (aad) = 0
                     if (l_state == KNOWN && AD_MODE (lad) == LLIT_AM)
                        AD_LIT1 (lad) = 0
                     else
                        l_state = UNKNOWN
                     }
                  }
               when (LT_INS) {
                  if (a_state == KNOWN && AD_MODE (aad) == ILIT_AM
                    && AD_LIT1 (aad) == 1)
                     discard_inst
                  else {
                     a_state = KNOWN
                     AD_MODE (aad) = ILIT_AM
                     AD_LIT1 (aad) = 1
                     if (l_state == KNOWN && AD_MODE (lad) == LLIT_AM)
                        AD_LIT1 (lad) = 1
                     else
                        l_state = UNKNOWN
                     }
                  }
               when (CRB_INS) {
                  if (l_state == KNOWN && AD_MODE (lad) == LLIT_AM)
                     AD_LIT2 (lad) = 0
                  else
                     l_state = UNKNOWN
                  }
               when (CRL_INS, CRLE_INS) {
                  if (l_state == KNOWN && AD_MODE (lad) == LLIT_AM
                    && AD_LIT1 (lad) == 0 && AD_LIT2 (lad) == 0)
                     discard_inst
                  else {
                     l_state = KNOWN
                     AD_MODE (lad) = LLIT_AM
                     AD_LIT1 (lad) = 0
                     AD_LIT2 (lad) = 0
                     a_state = KNOWN
                     AD_MODE (aad) = ILIT_AM
                     AD_LIT1 (aad) = 0
                     }
                  }
               when (TAB_INS) {
                  if (l_state == KNOWN && AD_MODE (lad) == LLIT_AM)
                     AD_LIT2 (lad) = AD_LIT1 (lad)
                  else
                     l_state = UNKNOWN
                  }
               when (TAX_INS) {
                  x_state = a_state
                  call ad_copy (aad, xad)
                  kill_indexed
                  }
               when (TXA_INS) {
                  a_state = x_state
                  call ad_copy (xad, aad)
                  l_state = UNKNOWN
                  }
               when (XCA_INS) {
                  if (l_state == KNOWN && AD_MODE (lad) == LLIT_AM) {
                     AD_LIT2 (lad) = AD_LIT1 (lad)
                     AD_LIT1 (lad) = 0
                     }
                  else
                     l_state = UNKNOWN
                  a_state = KNOWN
                  AD_MODE (aad) = ILIT_AM
                  AD_LIT1 (aad) = 0
                  }
               when (ARGT_INS, CGT_INS, FSGT_INS, FSLE_INS, FSMI_INS,
                 FSNZ_INS, FSPL_INS, FSZE_INS, SAR_INS, SAS_INS,
                 SGT_INS, SKP_INS, SLE_INS, SLN_INS, SLZ_INS, SMI_INS,
                 SNZ_INS, SPL_INS, SRC_INS, SSC_INS, SVC_INS, SZE_INS)
                  trash
               when (CRE_INS, FIN_INS, LINK_INS, NOP_INS, PROC_INS,
                 RCB_INS, SCB_INS, STPM_INS, TAK_INS, TAY_INS)
                  ;  # no effect on code we generated
               when (PRTN_INS) {
                        # This should be replaced by a set of general
                        # routines that delete unreachable code
                  if (Imem (REV (i)) == GENERIC_INSTRUCTION
                        && Imem (REV (i) + 3) == PRTN_INS)   # Duplicate
                     discard_inst
                  }
               when (DFCM_INS, FCM_INS, FDBL_INS, FLTA_INS, FLTL_INS,
                 FRN_INS) {
                  f_state = UNKNOWN
                  lf_state = UNKNOWN
                  }
               when (DRX_INS, IRX_INS) {
                  x_state = UNKNOWN
                  kill_indexed
                  }
            else
               ;  # bad generic instruction; will be reported later.
            }  # when (GENERIC_INSTRUCTION)

         when (MISC_INSTRUCTION) {
            select (Imem (i + 3))
               when (ENT_INS, ECB_INS, IP_INS, EXT_INS, DATA_INS,
                 BSZ_INS, AP_INS, DAC_INS)
                  ;  # does nothing in presently generated code
               when (ALL_INS, LLL_INS, ARL_INS, LRL_INS, ARS_INS, LRS_INS) {
                  a_state = UNKNOWN
                  l_state = UNKNOWN
                  }
               when (SHORT_JUMP_LABEL_INS, SHORT_JUMP_AHEAD_INS)
                  trash
               when (SETUP_OWNER_INS)
                  trash
            }

         when (MR_INSTRUCTION) {
            select (Imem (i + 3))
               when (ADD_INS, ADL_INS, ANA_INS, ANL_INS,
                 DIV_INS, DVL_INS, ERA_INS, ERL_INS,
                 IMA_INS, LDLR_INS, MPL_INS, MPY_INS, ORA_INS, SBL_INS,
                 SUB_INS) {
                  a_state = UNKNOWN
                  l_state = UNKNOWN
                  }
               when (CAS_INS, CLS_INS, DFCS_INS, FCS_INS, JMP_INS,
                 JST_INS, JSX_INS, JSXB_INS, JSY_INS, PCL_INS, XEC_INS)
                  trash
               when (DFAD_INS, DFDV_INS, DFMP_INS, DFSB_INS, FAD_INS,
                 FDV_INS, FMP_INS, FSB_INS) {
                  f_state = UNKNOWN
                  lf_state = UNKNOWN
                  }
               when (LDY_INS, STY_INS, EALB_INS)
                  ;     # not used in our code (at the moment)
               when (FLX_INS, DFLX_INS) {
                  x_state = UNKNOWN
                  kill_indexed
                  }
               when (LDA_INS) {
                  # if value is already in A, delete this instruction.
                  # if prev inst is a store into our loc, delete it.
                  # if value is in X, replace with a TXA.
                  # otherwise, leave it alone and record the new state.
                  if (a_state == KNOWN && ad_equal (Imem (i + 4), aad))
                     discard_inst
                  else if (Imem (REV (i)) == MR_INSTRUCTION
                    && Imem (REV (i) + 3) == STA_INS
                    && ad_equal (Imem (i + 4), Imem (REV (i) + 4)))
                     discard_inst
                  else if (x_state == KNOWN
                    && ad_equal (Imem (i + 4), xad)) {
                     call ad_copy (xad, aad)
                     a_state = KNOWN
                     l_state = UNKNOWN
                     new_i = gen_generic (TXA_INS)
                     FWD (new_i) = FWD (i)
                     REV (new_i) = REV (i)
                     FWD (REV (i)) = new_i
                     REV (FWD (i)) = new_i
                     i = new_i
                     a_state = KNOWN
                     call ad_copy (xad, aad)
                     }
                  else {
                     a_state = KNOWN
                     l_state = UNKNOWN
                     call ad_copy (Imem (i + 4), aad)
                     }
                  }
               when (LDL_INS) {
                  # if value is already in L, delete instruction;
                  # if previous inst stores into our addr, delete instruction;
                  # otherwise, leave it alone
                  if (l_state == KNOWN && ad_equal (Imem (i + 4), lad))
                     discard_inst
                  else if (Imem (REV (i)) == MR_INSTRUCTION
                    && Imem (REV (i) + 3) == STL_INS
                    && ad_equal (Imem (i + 4), Imem (REV (i) + 4)))
                     discard_inst
                  else {
                     l_state = KNOWN
                     call ad_copy (Imem (i + 4), lad)
                     call ad_copy (lad, aad)
                     if (AD_MODE (lad) == LLIT_AM)
                        AD_MODE (aad) = ILIT_AM
                     a_state = KNOWN
                     }
                  }
               when (FLD_INS) {
                  # if value is already in F, delete the load
                  # if previous inst stores into our addr, delete the load
                  if (f_state == KNOWN && ad_equal (Imem (i + 4), fad))
                     discard_inst
                  else if (Imem (REV (i)) == MR_INSTRUCTION
                    && Imem (REV (i) + 3) == FST_INS
                    && ad_equal (Imem (i + 4), Imem (REV (i) + 4)))
                     discard_inst
                  else {
                     f_state = KNOWN
                     call ad_copy (Imem (i + 4), fad)
                     }
                  lf_state = UNKNOWN
                  }
               when (DFLD_INS) {
                  # if value is already in LF, delete the load
                  # if prev inst is store into our addr, delete the load
                  if (lf_state == KNOWN && ad_equal (Imem (i + 4), lfad))
                     discard_inst
                  else if (Imem (REV (i)) == MR_INSTRUCTION
                    && Imem (REV (i) + 3) == DFST_INS
                    && ad_equal (Imem (i + 4), Imem (REV (i) + 4)))
                     discard_inst
                  else {
                     lf_state = KNOWN
                     call ad_copy (Imem (i + 4), lfad)
                     }
                  f_state = UNKNOWN
                  }
               when (LDX_INS) {
                  # if value is already in X, delete the load.
                  # if prev inst is store into our addr, delete the load.
                  # if value is in A, generate TAX and kill indexed refs.
                  # otherwise, leave the instruction alone. Record state.
                  if (x_state == KNOWN && ad_equal (Imem (i + 4), xad))
                     discard_inst
                  else if (Imem (REV (i)) == MR_INSTRUCTION
                    && Imem (REV (i) + 3) == STX_INS
                    && ad_equal (Imem (i + 4), Imem (REV (i) + 4)))
                     discard_inst
                  else if (a_state == KNOWN
                    && ad_equal (Imem (i + 4), aad)) {
                     new_i = gen_generic (TAX_INS)
                     FWD (new_i) = FWD (i)
                     REV (new_i) = REV (i)
                     FWD (REV (i)) = new_i
                     REV (FWD (i)) = new_i
                     i = new_i
                     x_state = KNOWN
                     call ad_copy (aad, xad)
                     kill_indexed
                     }
                  else {
                     x_state = KNOWN
                     call ad_copy (Imem (i + 4), xad)
                     kill_indexed
                     }
                  }
               when (STLR_INS) {    # used only to set XB in our code
                  # kill anything based on XB
                  xb_state = l_state
                  call ad_copy (lad, xbad)
                  kill_xb_rel
                  }
               when (EAL_INS) {
                  a_state = UNKNOWN
                  l_state = UNKNOWN
                  }
               when (EAXB_INS) {
                  xb_state = UNKNOWN
                  kill_xb_rel
                  }
               when (IRS_INS)
                  kill_address (1)
               when (STA_INS)
                  {
                  kill_address (1)
                  if (a_state == UNKNOWN)
                     {
                     a_state = KNOWN
                     call ad_copy (Imem (i + 4), aad)
                     }
                  }
               when (STX_INS)
                  {
                  kill_address (1)
                  if (x_state == UNKNOWN)
                     {
                     x_state = KNOWN
                     call ad_copy (Imem (i + 4), xad)
                     }
                  }
               when (STL_INS)
                  {
                  kill_address (2)
                  if (l_state == UNKNOWN)
                     {
                     l_state = KNOWN
                     call ad_copy (Imem (i + 4), lad)
                     }
                  }
               when (FST_INS)
                  {
                  kill_address (2)
                  if (f_state == UNKNOWN)
                     {
                     f_state = KNOWN
                     call ad_copy (Imem (i + 4), fad)
                     }
                  }
               when (DFST_INS)
                  {
                  kill_address (4)
                  if (lf_state == UNKNOWN)
                     {
                     lf_state = KNOWN
                     call ad_copy (Imem (i + 4), lfad)
                     }
                  }
            }  # end of MR_INSTRUCTION case

      }  # end of code scanning loop

   return


   procedure trash {
      a_state = UNKNOWN
      l_state = UNKNOWN
      f_state = UNKNOWN
      lf_state = UNKNOWN
      x_state = UNKNOWN
      xb_state = UNKNOWN
      }


   procedure kill_indexed {      # kill any addresses based on X
      if (a_state == KNOWN && (AD_MODE (aad) == INDEXED_AM
        || AD_MODE (aad) == INDIRECT_POSTX_AM
        || AD_MODE (aad) == PREX_INDIRECT_AM)) {
         a_state = UNKNOWN
         l_state = UNKNOWN
         }
      if (l_state == KNOWN && (AD_MODE (lad) == INDEXED_AM
        || AD_MODE (lad) == INDIRECT_POSTX_AM
        || AD_MODE (lad) == PREX_INDIRECT_AM)) {
         a_state = UNKNOWN
         l_state = UNKNOWN
         }
      if (f_state == KNOWN && (AD_MODE (fad) == INDEXED_AM
        || AD_MODE (fad) == INDIRECT_POSTX_AM
        || AD_MODE (fad) == PREX_INDIRECT_AM)) {
         f_state = UNKNOWN
         lf_state = UNKNOWN
         }
      if (lf_state == KNOWN && (AD_MODE (lfad) == INDEXED_AM
        || AD_MODE (lfad) == INDIRECT_POSTX_AM
        || AD_MODE (lfad) == PREX_INDIRECT_AM)) {
         f_state = UNKNOWN
         lf_state = UNKNOWN
         }
#  We don't kill X, since it was set in the process of getting here.
#      if (x_state == KNOWN && (AD_MODE (xad) == INDEXED_AM
#        || AD_MODE (xad) == INDIRECT_POSTX_AM
#        || AD_MODE (xad) == PREX_INDIRECT_AM))
#         x_state = UNKNOWN
      if (xb_state == KNOWN && (AD_MODE (xbad) == INDEXED_AM
        || AD_MODE (xbad) == INDIRECT_POSTX_AM
        || AD_MODE (xbad) == PREX_INDIRECT_AM))
         xb_state = UNKNOWN
      }


   procedure kill_xb_rel {    # kill any addresses based on XB
      if (a_state == KNOWN)
         select (AD_MODE (aad))
            when (ILIT_AM, LLIT_AM, FLIT_AM, DLIT_AM, LABELED_AM)
               ;
         else
            if (AD_BASE (aad) == XB_REG) {
               a_state = UNKNOWN
               l_state = UNKNOWN
               }
      if (l_state == KNOWN)
         select (AD_MODE (lad))
            when (ILIT_AM, LLIT_AM, FLIT_AM, DLIT_AM, LABELED_AM)
               ;
         else
            if (AD_BASE (lad) == XB_REG) {
               a_state = UNKNOWN
               l_state = UNKNOWN
               }
      if (f_state == KNOWN)
         select (AD_MODE (fad))
            when (ILIT_AM, LLIT_AM, FLIT_AM, DLIT_AM, LABELED_AM)
               ;
         else
            if (AD_BASE (fad) == XB_REG) {
               f_state = UNKNOWN
               lf_state = UNKNOWN
               }
      if (lf_state == KNOWN)
         select (AD_MODE (lfad))
            when (ILIT_AM, LLIT_AM, FLIT_AM, DLIT_AM, LABELED_AM)
               ;
         else
            if (AD_BASE (lfad) == XB_REG) {
               f_state = UNKNOWN
               lf_state = UNKNOWN
               }
      if (x_state == KNOWN)
         select (AD_MODE (xad))
            when (ILIT_AM, LLIT_AM, FLIT_AM, DLIT_AM, LABELED_AM)
               ;
         else
            if (AD_BASE (xad) == XB_REG)
               x_state = UNKNOWN
#  We don't kill XB, since it was set in the process of getting here.
#      if (xb_state == KNOWN)
#         select (AD_MODE (xbad))
#            when (ILIT_AM, LLIT_AM, FLIT_AM, DLIT_AM, LABELED_AM)
#               ;
#         else
#            if (AD_BASE (xbad) == XB_REG)
#               xb_state = UNKNOWN
      }


   procedure kill_address (width) {
      integer width

      # Here we kill any registers whose contents originated in a
      #  word within range of the address in the current instruction.
      #  Note that registers loaded from a constant should never be
      #  killed.

      local mode, base, offset
      integer mode, base, offset

      mode = Imem (i + 4)     # secret knowledge of AD_MODE
      base = Imem (i + 5)
      offset = Imem (i + 6)

      if (mode == LABELED_AM || base == XB_REG)
         trash    # I don't feel like handling these cases now.
      else if (mode == INDEXED_AM || mode == INDIRECT_AM
        || mode == INDIRECT_POSTX_AM || mode == PREX_INDIRECT_AM) {
         # Terminate any and all aliases, with extreme prejudice.
         if (a_state == KNOWN && AD_MODE (aad) ~= ILIT_AM) {
            a_state = UNKNOWN
            l_state = UNKNOWN
            }
         if (l_state == KNOWN && AD_MODE (lad) ~= LLIT_AM) {
            a_state = UNKNOWN
            l_state = UNKNOWN
            }
         if (f_state == KNOWN && AD_MODE (fad) ~= FLIT_AM) {
            f_state = UNKNOWN
            lf_state = UNKNOWN
            }
         if (lf_state == KNOWN && AD_MODE (lfad) ~= DLIT_AM) {
            f_state = UNKNOWN
            lf_state = UNKNOWN
            }
         if (x_state == KNOWN && AD_MODE (xad) ~= ILIT_AM)
            x_state = UNKNOWN
         if (xb_state == KNOWN && AD_MODE (xbad) ~= LLIT_AM)
            xb_state = UNKNOWN
         }
      else {
         # Kill any registers whose contents overlap the address
         if (a_state == KNOWN && AD_MODE (aad) == DIRECT_AM
           && AD_BASE (aad) == base
           && overlap (AD_OFFSET (aad), 1, offset, width)) {
            a_state = UNKNOWN
            l_state = UNKNOWN
            }
         if (l_state == KNOWN && AD_MODE (lad) == DIRECT_AM
           && AD_BASE (lad) == base
           && overlap (AD_OFFSET (lad), 2, offset, width)) {
            a_state = UNKNOWN
            l_state = UNKNOWN
            }
         if (f_state == KNOWN && AD_MODE (fad) == DIRECT_AM
           && AD_BASE (fad) == base
           && overlap (AD_OFFSET (fad), 2, offset, width)) {
            f_state = UNKNOWN
            lf_state = UNKNOWN
            }
         if (lf_state == KNOWN && AD_MODE (lfad) == DIRECT_AM
           && AD_BASE (lfad) == base
           && overlap (AD_OFFSET (lfad), 4, offset, width)) {
            f_state = UNKNOWN
            lf_state = UNKNOWN
            }
         if (x_state == KNOWN && AD_MODE (xad) == DIRECT_AM
           && AD_BASE (xad) == base
           && overlap (AD_OFFSET (xad), 1, offset, width))
            x_state = UNKNOWN
         if (xb_state == KNOWN && AD_MODE (xbad) == DIRECT_AM
           && AD_BASE (xbad) == base
           && overlap (AD_OFFSET (xbad), 2, offset, width))
            xb_state = UNKNOWN
         }
      }


   procedure discard_inst {
      FWD (REV (i)) = FWD (i)
      REV (FWD (i)) = REV (i)
      i = REV (i)
      }


   end



# simplify --- replace an instruction with a simpler one

   subroutine simplify (instr)
   ipointer instr

   include VCG_COMMON

   ipointer new_instr, i
   ipointer gen_generic, gen_mr

   integer ad (ADDR_DESC_SIZE)

   procedure replace forward

   i = instr

   select (Imem (i))

      when (MR_INSTRUCTION) {
         select (Imem (i + 3))

            when (LDA_INS) {
               call ad_copy (Imem (i + 4), ad)
               if (AD_MODE (ad) == ILIT_AM && AD_LIT1 (ad) == 0) {
                  new_instr = gen_generic (CRA_INS)
                  replace
                  }
               else if (AD_MODE (ad) == ILIT_AM && AD_LIT1 (ad) == 1) {
                  new_instr = gen_generic (LT_INS)
                  replace
                  }
               }

# Commented out because it's probably not worth it, and also because
#  CAZ isn't defined:
#            when (CAS_INS) {
#               call ad_copy (Imem (i + 4), ad)
#               if (AD_MODE (ad) == ILIT_AM && AD_LIT1 (ad) == 0) {
#                  new_instr = gen_generic (CAZ_INS)
#                  replace
#                  }
#               }

            when (LDL_INS) {
               call ad_copy (Imem (i + 4), ad)
               if (AD_MODE (ad) == LLIT_AM && AD_LIT1 (ad) == 0
                 && AD_LIT2 (ad) == 0) {
                  new_instr = gen_generic (CRL_INS)
                  replace
                  }
               }

            when (EAL_INS) {
               call ad_copy (Imem (i + 4), ad)
               if (AD_MODE (ad) == INDIRECT_AM) {
                  AD_MODE (ad) = DIRECT_AM
                  new_instr = gen_mr (LDL_INS, ad)
                  replace
                  }
               }

            when (ADD_INS) {
               call ad_copy (Imem (i + 4), ad)
               if (AD_MODE (ad) == ILIT_AM)
                  select (AD_LIT1 (ad))
                     when (1)
                        new_instr = gen_generic (A1A_INS)
                     when (2)
                        new_instr = gen_generic (A2A_INS)
                     when (-1)
                        new_instr = gen_generic (S1A_INS)
                     when (-2)
                        new_instr = gen_generic (S2A_INS)
                  ifany
                     replace
               }

            when (SUB_INS) {
               call ad_copy (Imem (i + 4), ad)
               if (AD_MODE (ad) == ILIT_AM)
                  select (AD_LIT1 (ad))
                     when (1)
                        new_instr = gen_generic (S1A_INS)
                     when (2)
                        new_instr = gen_generic (S2A_INS)
                     when (-1)
                        new_instr = gen_generic (A1A_INS)
                     when (-2)
                        new_instr = gen_generic (A2A_INS)
                  ifany
                     replace
               }

         }  # end MR_INSTRUCTION case of instruction type

   else
      ; # bad instruction type, but we'll wait to complain later

   return


   procedure replace {
      FWD (REV (instr)) = new_instr
      REV (FWD (instr)) = new_instr
      FWD (new_instr) = FWD (instr)
      REV (new_instr) = REV (instr)
      instr = new_instr
      }


   end



# overlap --- determine if two address ranges overlap

   logical function overlap (start1, len1, start2, len2)
   unsigned start1, len1, start2, len2

   long_int low, high

   if (UTOL (start1) < UTOL (start2))
      low = UTOL (start1)
   else
      low = UTOL (start2)

   if (UTOL (start1 + len1) > UTOL (start2 + len2))
      high = UTOL (start1 + len1)
   else
      high = UTOL (start2 + len2)

   return (high - low < len1 + len2)
   end



# ad_copy --- copy one address descriptor into another

   subroutine ad_copy (src, dst)
   integer src (ADDR_DESC_SIZE), dst (ADDR_DESC_SIZE)

   integer i

   for (i = 1; i <= ADDR_DESC_SIZE; i += 1)
      dst (i) = src (i)

   return
   end



# ad_equal --- return TRUE if two address descriptors are identical

   logical function ad_equal (ad1, ad2)
   integer ad1 (ADDR_DESC_SIZE), ad2 (ADDR_DESC_SIZE)

   if (AD_MODE (ad1) ~= AD_MODE (ad2))
      return (FALSE)

   select (AD_MODE (ad1))
      when (ILIT_AM)
         return (AD_LIT1 (ad1) == AD_LIT1 (ad2))
      when (LLIT_AM, FLIT_AM)
         return (AD_LIT1 (ad1) == AD_LIT1 (ad2) _
            & AD_LIT2 (ad1) == AD_LIT2 (ad2))
      when (DLIT_AM)
         return (AD_LIT1 (ad1) == AD_LIT1 (ad2) _
            & AD_LIT2 (ad1) == AD_LIT2 (ad2) _
            & AD_LIT3 (ad1) == AD_LIT3 (ad2) _
            & AD_LIT4 (ad1) == AD_LIT4 (ad2))
      when (LABELED_AM)
         return (AD_LABEL (ad1) == AD_LABEL (ad2))
      when (DIRECT_AM, INDIRECT_AM, INDEXED_AM,
        INDIRECT_POSTX_AM, PREX_INDIRECT_AM)
         return (AD_BASE (ad1) == AD_BASE (ad2) _
            & AD_OFFSET (ad1) == AD_OFFSET (ad2))
   else
      call warning ("*i: bad address descriptor mode in ad_equal*n"p,
         AD_MODE (ad1))

   return (FALSE)
   end



undefine(FWD)
undefine(REV)
undefine(KNOWN)
undefine(UNKNOWN)
undefine(UTOL)
