Hi...

I signed onto an AS/400 today for the first time since July of 2003.  It was
interesting!  I wanted to make sure all these things at least compiled.
They did, with one or two exceptions that are noted in the NOTES TO USERS
file that I am including with this E-mail.  Also the missing four source
files, including the ADDPTR small MI program!

I had a hard time getting ADDPTR to compile over there.  I finally realized
their CRTMIPGM front end to QPRCRTPG (which is itself a front end to the
actual program resolution monitor, I am told) does NOT have a "convert code
to upper case" feature.  I like mixed case in my MI code, but that's not
universal.  So I send the corrected copy of ADDPTR.

It was a bit of a challenge getting all the source up there with FTP too,
but that's another issue.  I was a bit rusty on my FTP skills!

I wanted to quickly run the debugger to test it, and it came up OK, but
because the MI program I tested did not have the requisite information in
its object repository (thus DSPPGM does not show the source file/member
information), the debugger couldn't find the source code of the program to
debug.  Oh well.

Enjoy!

Rich Hart
(405 946-6667
/* ---------------------------------------------------------------- */
/*  This module is the exclusive property of Mosaic, Inc.           */
/*  No portion of this code may be reproduced for any reason        */
/*  without the express written permission of Mosaic, Inc.          */
/* ---------------------------------------------------------------- */
/*  ADDPTR:  Add an OFFSET to a Space Pointer                       */
/* ---------------------------------------------------------------- */

DCL   SPCPTR  .SPCPTR  PARM;
DCL   SPCPTR   SPCPTR  BAS(.SPCPTR);
DCL   SPCPTR  .OFFSET  PARM;

DCL   DD       OFFSET  BAS(.OFFSET)  BIN(4);

/*  ---  Operand Definitions  ---                                   */

DCL  OL  PARM-LIST(.SPCPTR, .OFFSET)  PARM  MIN(2)  EXT;

/* ---------------------------------------------------------------- */
/*  MAIN-LINE:                                                      */
/* ---------------------------------------------------------------- */
ENTRY  ENTRY-POINT  (PARM-LIST)  EXT;

/*  ---  Adjust the Space pointer by the signed offset  ---         */

ADDSPP  SPCPTR, SPCPTR, OFFSET;

RTX     *;
PEND;
/* ---------------------------------------------------------------- */
/*  This module is the exclusive property of Mosaic, Inc.           */
/*  No portion of this code may be reproduced for any reason        */
/*  without the express written permission of Mosaic, Inc.          */
/* ---------------------------------------------------------------- */
/*  ENDMIDBG:  End the MI Debugging Session                         */
/* ---------------------------------------------------------------- */

    CMD       PROMPT('End the MI Debugging Session')

/* ---------------------------------------------------------------- */
/*  This module is the exclusive property of Mosaic, Inc.           */
/*  No portion of this code may be reproduced for any reason        */
/*  without the express written permission of Mosaic, Inc.          */
/* ---------------------------------------------------------------- */
/*  ENDMIDBGCL:  End the NMI Debugging Session                      */
/* ---------------------------------------------------------------- */
             PGM

             DCL        VAR(&PGM) TYPE(*CHAR) LEN(10) VALUE('*EXIT')
             DCL        VAR(&LVL) TYPE(*CHAR) LEN( 5)
             DCL        VAR(&HIL) TYPE(*CHAR) LEN(10)
             DCL        VAR(&MIL) TYPE(*CHAR) LEN( 5)

/*  ---  Bring the interactive NMI debugger to an end  ---          */

             CALL       PGM(RUNDBG) PARM( +
                          &PGM +
                          &LVL +
                          &HIL +
                          &MIL +
                          )

/*  ---  Bring the interactive NMI debugger to an end  ---          */

             ENDDBG

             ENDPGM

        Must get in addition:

1.  RunDbg      *RPG
2.  AddPtr      *MI
3.  EndMiDbg    *CMD
4.  EndMiDbgCl  *CLP

        Must do this in additon:

1.  Change the /Copy reference in RUNDBG to point to the
    library and source file you put the MACHINE prototype
    source member into.

2.  Change the code in the MI program ADDPTR to all upper
    case if your front-end does not do so automatically.
      * ---------------------------------------------------------------- *
      *  This program is the exclusive property of Mosaic, Inc.          *
      *  No portion of this code may be reproduced for any reason        *
      *  without the express written permission of Mosaic, Inc.          *
      * ---------------------------------------------------------------- *
      *  RUNDBG:  Run the Machine Interface Source Debugger              *
      * ---------------------------------------------------------------- *
      *  Notes:  1. Use an internal procedure for SysExecute, since      *
      *             we can effectively do error trapping.  For example,  *
      *             the DSPPGMVAR command fails if a variable whose      *
      *             pointer is not set is addressed.  However, for the   *
      *             // OvrDbf command to work correctly when called      *
      *             from an internal subprocedure, the program must      *
      *             first have been compiled using a named *ActGrp.      *
      * ---------------------------------------------------------------- *
      *  DATA-DIVISION:                                                  *
      * ---------------------------------------------------------------- *
     FRunDbgFm  CF   E             WorkStn  SFile(Sfl:Rrn)
     F                                      InfDs(InfDs)
      *
     FSrc       IF   F   92        Disk     UsrOpn
      * ---------------------------------------------------------------- *
      *  STORAGE-SECTION:                                                *
      * ---------------------------------------------------------------- *
      /Copy Hart/CpySrc,Machine
      *
      *  ---  Linkage Definitions  ---
      *
     D SysExecute      PR
     D CmdText                      256A
    DD CmdLen                        15P 5
      *
      *  ---  Message Definitions  ---
      *
     D Action          S             10
     D MsgDta          S             75A
     D MsgF            S             20A
     D MsgFmt          S              8A
     D MsgId           S              7A
     D MsgKey          S              4A
     D MsgLen          S             10I 0
     D MsgTyp          S             10A
     D MsgWait         S             10I 0
     D StkCnt          S             10I 0
     D StkEnt          S             10A
      *
      *  ---  General Definitions  ---
      *
     D ArrIdx          S              5I 0
     D CmdText         S            256A
     D CmdLen          S             15P 5
     D Curr            S              4P 0
     D Digits          S              1A    Dim(10)
     D EndRrn          S              4P 0
     D EntryValue      S              4A
     D ErrMsgId        S              7A
     D File            S             10A
     D Finis           S              5I 0
     D First           S             10I 0
     D HiLvlIns        S             10A
     D Index           S              5I 0
     D InpChar         S              8A
     D InpFile         S             21A
     D InpHex          S              4A    Based(HexPtr)
     D InpLin          S              1A    Based(InpPtr)  Dim(40)
     D InpSiz          S             10I 0
     D Input           S             75A
     D Instruct        S              7A
     D Integer         S             10I 0
     D Last            S              4P 0
     D Length          S             10I 0
     D LineType        S              1A
     D Mask            S              3A
     D Member          S             10A
     D MiInst          S              4A    Dim(50)
     D MiInsNbr        S             10I 0
     D MiLvlIns        S              5A
     D Next            S             10I 0
     D NonBlank        S              5I 0
     D NxtInsNbr       S             10I 0
     D OutChar         S              8A
     D OutDesc         S              7A
     D OutHex          S              4A    Based(HexPtr)
     D PndLinTyp       S              1A
     D Program         S             10A
     D PrvBotKey       S              4P 0
     D PrvTopKey       S              4P 0
     D Qualif          S             21A
     D RecurLvl        S              5A
     D Rrn             S              4P 0
     D SavCommand      S             75A
     D SavFndCmd       S             75A
     D SavFndNbr       S              4P 0
     D SavKeyNbr       S              4P 0
     D OutNumber       S             10I 0
     D SfMiLvlIns      S             10A
     D SrcLin          S              1A    Based(LinPtr)  Dim(75)
     D Start           S              5I 0
     D StrArr          S              1A    Dim(40) Based(ArrPtr)
     D String          S             40A
     D Total           S              5I 0
     D TrMiI           S              4A
     D TrName          S             10A
     D TrLibr          S             10A
     D TrSrcMbr        S             10A
     D TrSrcObj        S             10A
     D TrSrcLib        S             10A
     D TrAttr          S             10A
     D TxtDta          S             80A
     D TxSrc           S             75A
     D Variable        S             30A
      *
      *  ---  General Definitions  ---
      *
     D Descript        DS
     D ScalarType                     1A
     D ScalarLen                      2A
     D Reserved                       4A
      *
     D Error           DS                   INZ
     D BytPrv                         8B 0
     D BytAvl                         8B 0
     D ErrMsg                         7A
     D Reserve                        1A
     D ErrDta                        75A
      *
     D Lin             S              4S 0  Dim(16) Based(LinArrPtr)
      *
     D LinArr          DS                   Inz
     D Lin01                          4S 0
     D Lin02                          4S 0
     D Lin03                          4S 0
     D Lin04                          4S 0
     D Lin05                          4S 0
     D Lin06                          4S 0
     D Lin07                          4S 0
     D Lin08                          4S 0
     D Lin09                          4S 0
     D Lin10                          4S 0
     D Lin11                          4S 0
     D Lin12                          4S 0
     D Lin13                          4S 0
     D Lin14                          4S 0
     D Lin15                          4S 0
     D Lin16                          4S 0
      *
     D Txt             S             74A    Dim(16) Based(TxtArrPtr)
      *
     D TxtArr          DS                   Inz
     D Txt01                         74A
     D Txt02                         74A
     D Txt03                         74A
     D Txt04                         74A
     D Txt05                         74A
     D Txt06                         74A
     D Txt07                         74A
     D Txt08                         74A
     D Txt09                         74A
     D Txt10                         74A
     D Txt11                         74A
     D Txt12                         74A
     D Txt13                         74A
     D Txt14                         74A
     D Txt15                         74A
     D Txt16                         74A
      *
      *  ---  Pointer Definitions  ---
      *
     D LinArrPtr       S               *    Inz(%Addr(LinArr))
     D ArrPtr          S               *
     D HexPtr          S               *
     D InpPtr          S               *
     D LinPtr          S               *
     D NxtPtr          S               *
     D TxtArrPtr       S               *    Inz(%Addr(TxtArr))
      *
      *  ---  Indicator Definitions  ---
      *
     D BrkPntSet       S              1N    Inz('0')
     D DbgCmdVal       S              1N    Inz('0')
     D HavePgmVar      S              1N    Inz('0')
     D ModHltPnt       S              1N    Inz('0')
     D PendingSts      S              1N    Inz('0')
     D SaveInd         S              1N    Inz('0')
     D StepMode        S              1N    Inz('0')
      *
     D $Src          E DS                   ExtName(Src)
     D InfDs         E DS                   ExtName(InfDs)
     D PgmStatus     ESDS                   ExtName(StsDs)
      *
      *  ---  Literal Definitions  ---
      *
     D BlnkLine        C                    Const('B')
     D BreakMark       C                    Const('^')
     D BkpPgm          C                    Const('BkpPgm(RunDbg)')
     D BrkPRqs         C                    Const(X'36')
     D CmdError        C                    Const('CPF0006')
     D Comma           C                    Const(',')
     D CommChar        C                    Const('/*')
     D CommLine        C                    Const('C')
     D CommRqs         C                    Const(X'B9')
     D ContRqs         C                    Const(X'3C')
     D DeclChar        C                    Const('DCL ')
     D DeclLine        C                    Const('D')
     D DftPgm          C                    Const('Pgm(*DftPgm)')
     D DispRqs         C                    Const(X'3A')
     D EndCChar        C                    Const('*/')
     D EndParan        C                    Const(')')
     D EntrChar        C                    Const('ENTRY ')
     D EntrLine        C                    Const('E')
     D ErrDtaSiz       C                    Const(%Size(Error))
     D ExecAny         C                    Const('*N ')
     D ExecBot         C                    Const('BT ')
     D ExecDn          C                    Const('DN ')
     D ExecEval        C                    Const('EV ')
     D ExecFind        C                    Const('FN ')
     D ExecPos         C                    Const('PT ')
     D ExecSrcP        C                    Const('SP ')
     D ExecText        C                    Const('ST ')
     D ExecTop         C                    Const('TP ')
     D ExecUp          C                    Const('UP ')
     D ExecCmdSiz      C                    Const(%Size(ExecAny))
     D ExecRqs         C                    Const(X'F1')
     D ExitRqs         C                    Const(X'33')
     D ExitText        C                    Const('The MI Debug Session ended')
     D GotoRqs         C                    Const(X'37')
     D HomeRqs         C                    Const(X'F8')
     D InpChrSiz       C                    Const(%Size(InpChar))
     D InpHexSiz       C                    Const(%Size(InpHex))
     D InputLimit      C                    Const(%Elem(InpLin))
     D InstLine        C                    Const('I')
     D IntensAtr       C                    Const(X'22')
     D LablLine        C                    Const('L')
     D Limit           C                    Const(%Size(TrInp))
     D LineLimit       C                    Const(%Elem(SrcLin))
     D Lower           C                    Const('abcdefghijklmnopqrstuvwxyz')
     D LowHexVal       C                    Const('0000')
     D MaxSize         C                    Const(9999)
     D NormalAtr       C                    Const(X'20')
     D PagSiz          C                    Const(16)
     D PendLine        C                    Const('P')
     D Quote           C                    Const('''')
     D ReqsText        C                    Const('This is a Request message')
     D RpCmRqs         C                    Const(X'39')
     D RpFnRqs         C                    Const(X'B4')
     D RqsLvl          C                    Const('RqsLvl(*Prv)')
     D Scope           C                    Const('OpnScope(*ActGrpDfn)')
     D SemiC           C                    Const(';')
     D SemiChar        C                    Const(';')
     D Slash           C                    Const('/')
     D Space           C                    Const(' ')
     D SpcError        C                    Const('CPF1999')
     D SpecChar        C                    Const('/*''/*''/*"/*"*/;')
     D SrcFile         C                    Const('SRC')
     D StepRqs         C                    Const(X'35')
     D StringLim       C                    Const(%Size(String))
     D StrParan        C                    Const('(')
     D Ten             C                    Const(10)
     D Upper           C                    Const('ABCDEFGHIJKLMNOPQRSTUVWXYZ')
     D ViewOnly        C                    Const('Option(5)')
     D Zero            C                    Const('0000')
      * ---------------------------------------------------------------- *
      *  LINKAGE-SECTION:                                                *
      * ---------------------------------------------------------------- *
      *
     C     *Entry        Plist
     C                   Parm                    Program
     C                   Parm                    RecurLvl
     C                   Parm                    HiLvlIns
     C                   Parm                    MiLvlIns
      *
      * ---------------------------------------------------------------- *
      *  MAIN-LINE:                                                      *
      * ---------------------------------------------------------------- *
     C     Main          Tag
      *
     C                   Exsr      ChkforExit
     C                   Exsr      RtvSrc
     C                   Exsr      DspSrc
      *
     C                   DoW       ( InKey  <>  ContRqs  and
     C                               InKey  <>  ExitRqs )
     C                   Exsr      HdlSfl
     C                   Exsr      DspSrc
     C                   Enddo
      *
     C                   Exsr      Terminate
      * ---------------------------------------------------------------- *
      *  *Inzsr:  Perform initial operations                             *
      * ---------------------------------------------------------------- *
     C     *Inzsr        Begsr
      *
     C                   Eval      SflNbr = 1
      *
      *  Get Module source attributes
      *
     C                   Exsr      GetModAtr
     C                   Exsr      SetDspNam
     C                   Exsr      SetInpNam
     C                   Exsr      SetEdtVal
     C                   Exsr      SetRqsAtr
      *
      *  Open the Source input file
      *
     C                   Eval      File   = SrcFile
     C                   Eval      Qualif = InpFile
     C                   Eval      Member = TrSrcMbr
     C                   Exsr      Override
     C                   Open      Src
      *
      *  Initialize pointers and "Bytes Provided"
      *
     C                   Eval      ArrPtr  = %Addr(String)
     C                   Eval      InpPtr  = %Addr(String)
     C                   Eval      BytPrv  = ErrDtaSiz
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  AddBrkPnt:  Add Breakpoint for MI instruction                   *
      * ---------------------------------------------------------------- *
     C     AddBrkPnt     Begsr
      *
     C                   Exsr      SetInsNbr
      *
      *  Action that is requested is to ADD a breakpoint
      *
     C                   Eval      CmdText  = 'AddBkp'    + ' ' +
     C                                         StrParan   + ' ' +
     C                                         Instruct   + ' ' +
     C                                         EndParan   + ' ' +
     C                                         BkpPgm
     C                   Eval      CmdLen   =  %Size(CmdText)
      *
      *  Execute the indicated ADDBKP command for breakpoint
      *
     C                   CallP     SysExecute(CmdText:
     C                                        CmdLen
     C                                        )
      *
     C                   Eval      BrkPntSet = *On
     C                   Eval      ModHltPnt = SfHlt
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  AddRmvBkp:  Add or remove a program Breakpoint                  *
      * ---------------------------------------------------------------- *
     C     AddRmvBkp     Begsr
      *
     C                   Exsr      GetSrcDta
      *
     C     TrMiI         Lookup    MiInst                                 77
      *
      *  Action that is requested is to ADD a breakpoint
      *
     C                   If        *In77 = *Off
     C                   Exsr      AddBrkPnt
     C                   Exsr      AddRmvIns
     C                   Exsr      PutSflDta
     C                   Endif
      *
      *  Action that is requested is to SUB a breakpoint
      *
     C                   If        *In77 = *On
     C                   Exsr      RmvBrkPnt
     C                   Exsr      AddRmvIns
     C                   Exsr      PutSflDta
     C                   Endif
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  AddRmvIns:  Insert or delete Breakpoint from Array              *
      * ---------------------------------------------------------------- *
     C     AddRmvIns     Begsr
      *
      *  Save the indicator's original value
      *
     C                   Eval      SaveInd = *In77
      *
     C                   Eval      Index = 1
      *
     C     SfMiI         Lookup    MiInst(Index)                          77
      *
     C                   If        not  *In77
      *
      *  Action that is requested is to ADD a breakpoint
      *
     C     *Blank        Lookup    MiInst(Index)                          77
     C                   If        *In77
     C                   Eval      MiInst(Index) = SfMiI
     C                   Endif
     C                   Else
      *
      *  Action that is requested is to SUB a breakpoint
      *
     C                   Eval      MiInst(Index) = *Blank
     C                   Endif
      *
     C                   Eval      *In77 = SaveInd
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  AdjPagKey:  Adjust SFL page key to reflect previous page        *
      * ---------------------------------------------------------------- *
     C     AdjPagKey     Begsr
      *
     C                   If        SflNbr >= PrvTopKey  and
     C                             SflNbr <= PrvBotKey
     C                   Eval      SflNbr  = PrvTopKey
     C                   Endif
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  CheckAlias:  Check for aliases "F" and "FT" for Find Text       *
      * ---------------------------------------------------------------- *
     C     CheckAlias    Begsr
      *
     C                   Exsr      RstCmdVal
      *
      *  Get the first non-blank character in Input
      *
     C                   Eval      NonBlank = *Zero
      *
     C     Space         Check     Input         Index                    77
      *
     C                   Eval      NonBlank = Index
      *
      *  Check for the Find Text alias value of "F"
      *
     C     'F '          Scan      Input         Index                    77
      *
     C                   If        Index = NonBlank  and
     C                             Index > *Zero
     C                   Eval      Start = Index + %Size('F ')
     C                   Eval      Total = Limit - Start + 1
     C                   Eval      Input = %Subst(Input:Start:Total)
     C                   Eval      Input = 'FN ' + Input
     C                   Else
      *
      *  Check for the Find Text alias value of "FT"
      *
     C     'FT '         Scan      Input         Index                    77
      *
     C                   If        Index = NonBlank  and
     C                             Index > *Zero
     C                   Eval      Start = Index + %Size('FT ')
     C                   Eval      Total = Limit - Start + 1
     C                   Eval      Input = %Subst(Input:Start:Total)
     C                   Eval      Input = 'FN ' + Input
     C                   Endif
     C                   Endif
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  ChkforExit:  Check for exit request at end of session           *
      * ---------------------------------------------------------------- *
     C     ChkforExit    Begsr
      *
     C                   If        Program = '*EXIT'
      *
     C                   Exsr      SetSndDta
      *
      *  Send an informational Message to the Requestor
      *
     C                   Call      'QMHSNDPM'
     C                   Parm                    MsgId
     C                   Parm                    MsgF
     C                   Parm      ExitText      MsgDta
     C                   Parm      75            MsgLen
     C                   Parm      '*INFO'       MsgTyp
     C                   Parm      '*'           StkEnt
     C                   Parm      3             StkCnt
     C                   Parm                    MsgKey
     C                   Parm                    Error
      *
     C                   Eval      *Inlr = *On
     C                   Return
      *
     C                   Endif
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  ChkPndLin:  Check the *Pending status of current line           *
      * ---------------------------------------------------------------- *
     C     ChkPndLin     Begsr
      *
      *  Check if this is a pending Comment statement line
      *
     C                   If        PendingSts = *Off
     C     DeclChar      Scan      TxtDta        Index                    77
     C                   If        Index > *Zero
     C     SemiChar      Scan      TxtDta        Index                    77
     C                   If        Index = *Zero
     C                   Eval      LineType   = PendLine
     C                   Eval      PndLinTyp  = DeclLine
     C                   Eval      PendingSts = *On
     C                   Endif
     C                   Endif
     C                   Endif
      *
      *  Check if this is a pending Comment statement line
      *
     C                   If        PendingSts = *Off
     C     CommChar      Scan      TxtDta        Index                    77
     C                   If        Index > *Zero
     C     EndCChar      Scan      TxtDta        Index                    77
     C                   If        Index = *Zero
     C                   Eval      LineType   = PendLine
     C                   Eval      PndLinTyp  = CommLine
     C                   Eval      PendingSts = *On
     C                   Endif
     C                   Endif
     C                   Endif
      *
      *  Check if this is a delimit Declare statement line
      *
     C                   If        PendingSts = *On  and
     C                             PndLinTyp  = DeclLine
     C     SemiChar      Scan      TxtDta        Index                    77
     C                   If        Index > *Zero
     C                   Eval      LineType   = DeclLine
     C                   Eval      PndLinTyp  = *Blank
     C                   Eval      PendingSts = *Off
     C                   Endif
     C                   Endif
      *
      *  Check if this is a delimit Comment statement line
      *
     C                   If        PendingSts = *On  and
     C                             PndLinTyp  = CommLine
     C     EndCChar      Scan      TxtDta        Index                    77
     C                   If        Index > *Zero
     C                   Eval      LineType   = CommLine
     C                   Eval      PndLinTyp  = *Blank
     C                   Eval      PendingSts = *Off
     C                   Endif
     C                   Endif
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  ChkSpcTxt:  Check for presence of special "Safeguard" code      *
      * ---------------------------------------------------------------- *
     C     ChkSpcTxt     Begsr
      *
     C                   If        LineType = CommLine
     C     SpecChar      Scan      TxtDta        Index                    77
     C                   If        Index > *Zero
     C                   Eval      LineType = DeclLine
     C                   Endif
     C                   Endif
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  ClrSflData:  Initialize the SFL                                 *
      * ---------------------------------------------------------------- *
     C     ClrSflData    Begsr
      *
     C                   Eval      *In01 = *Off
     C                   Eval      *In02 = *Off
     C                   Write     Ctl
     C                   Eval      *In01 = *On
     C                   Eval      *In02 = *Off
      *
     C                   Eval      Rrn      = *Zero
     C                   Eval      *In99    = *Off
     C                   Eval      Mic      = *Blank
     C                   Eval      MiInsNbr = *Zero
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  CvtChrHex:  Convert character value to hex value                *
      * ---------------------------------------------------------------- *
     C     CvtChrHex     Begsr
      *
     C                   Eval      InpChar = Zero + TrMiI
     C                   Eval      InpSiz  = InpChrSiz
      *
      *  Note that size is expressed in bytes of character source
      *
     C                   CallP     CvtCh(OutHex:
     C                                   InpChar:
     C                                   InpSiz
     C                                   )
      *
     C                   Eval      HexPtr    = %Addr(NxtInsNbr)
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  CvtHexChr:  Convert hex value to character value                *
      * ---------------------------------------------------------------- *
     C     CvtHexChr     Begsr
      *
     C                   Eval      HexPtr = %Addr(NxtInsNbr)
     C                   Eval      InpSiz = InpHexSiz * 2
      *
      *  Note that size is expressed in nibbles of hex source
      *
     C                   CallP     CvtHc(OutChar:
     C                                   InpHex:
     C                                   InpSiz
     C                                   )
      *
     C                   Eval      TrMiI = %Subst(OutChar:5:4)
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  DspCmdLin:  Display the Command Line                            *
      * ---------------------------------------------------------------- *
     C     DspCmdLin     Begsr
      *
     C                   Call      'QUSCMDLN'
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  DspError:  Display the appropriate Error message                *
      * ---------------------------------------------------------------- *
     C     DspError      Begsr
      *
     C                   Eval      *In99  = *On
     C                   Eval      Mic    = '0104'
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  DspPgmVar:  Display Program Variable requested by F11           *
      * ---------------------------------------------------------------- *
     C     DspPgmVar     Begsr
      *
     C                   Eval      Index = *Zero
     C                   Eval      Start = *Zero
     C                   Eval      Finis = *Zero
      *
      *  Get the Name of the variable to display
      *
     C                   Eval      HavePgmVar = *Off
      *
     C                   Exsr      GetSrcDta
      *
     C     Space         Check     SfSrc:Pos     Index                    77
      *
     C                   If        Index   > *Zero
     C                   Eval      Start   = Index
     C                   Eval      LinPtr  = %Addr(SfSrc)
     C                   DoU       HavePgmVar = *On
     C                   If        SrcLin(Index) = Space  or
     C                             SrcLin(Index) = Comma  or
     C                             SrcLin(Index) = SemiC
     C                   Eval      Finis = Index - 1
     C                   Exsr      SetPgmVar
     C                   Eval      HavePgmVar = *On
     C                   Leave
     C                   Else
     C                   If        Index = LineLimit
     C                   Leave
     C                   Else
     C                   Eval      Index = Index + 1
     C                   Endif
     C                   Endif
     C                   Enddo
     C                   Endif
      *
      *  If Index > zero, we have found a non-blank character
      *
     C                   If        HavePgmVar = *On
     C                   Exsr      DsptheVar
     C                   Else
     C                   Exsr      DspError
     C                   Endif
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  DspSrc:  Display the MI Source program                          *
      * ---------------------------------------------------------------- *
     C     DspSrc        Begsr
      *
     C                   Write     Hdr
     C                   Exfmt     Ctl
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  DsptheVar:  Display the Program Variable in *Exec mode          *
      * ---------------------------------------------------------------- *
     C     DsptheVar     Begsr
      *
     C                   Eval      CmdText  = 'DspPgmVar' + ' ' +
     C                                         StrParan   + ' ' +
     C                                         Quote      + ' ' +
     C                                         Variable   + ' ' +
     C                                         Quote      + ' ' +
     C                                         EndParan
     C                   Eval      CmdLen   =  %Size(CmdText)
      *
     C                   CallP     SysExecute(CmdText:
     C                                        CmdLen
     C                                        )
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  GetCurrPos:  Get current line number to search from             *
      * ---------------------------------------------------------------- *
     C     GetCurrPos    Begsr
      *
     C                   If        Input  = SavFndCmd  and
     C                             SflNbr = SavKeyNbr  and
     C                             EndRrn > SavFndNbr
     C                   Eval      Curr   = SavFndNbr + 1
     C                   Else
     C                   Eval      Curr   = SflNbr
     C                   Endif
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  GetEntVal:  Get the Entry MI instruction value                  *
      * ---------------------------------------------------------------- *
     C     GetEntVal     Begsr
      *
     C                   Eval      EntryValue = %Subst(HiLvlIns:2:4)
      *
      *  Make sure that the instruction is valid
      *
     C                   If        EntryValue = *Blank
     C                   Eval      EntryValue = LowHexVal
     C                   Endif
      *
     C                   Eval      TrMiI = EntryValue
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  GetFirsChr:  Get first non-blank character in the argument      *
      * ---------------------------------------------------------------- *
     C     GetFirsChr    Begsr
      *
      *  Make sure first byte to check is not past the space
      *
     C                   If        First > Limit
     C                   Eval      First = Limit
     C                   Endif
      *
      *  Find the leftmost boundary of the effective argument
      *
     C     Space         Check     Input:First   Index                    77
      *
     C                   If        Index > *Zero
     C                   Eval      Next  =  Index
     C                   Else
     C                   Eval      Next  =  First
     C                   Endif
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  GetLastChr:  Get last non-blank character in the argument       *
      * ---------------------------------------------------------------- *
     C     GetLastChr    Begsr
      *
      *  Find the rightmost boundary of the effective argument
      *
     C     Space         Checkr    String        Index                    77
      *
     C                   If        Index  > *Zero
     C                   Eval      Length = Index
     C                   Else
     C                   Eval      Length = First
     C                   Endif
      *
      *  Make sure the last byte to check is not past the space
      *
     C                   If        Length > StringLim
     C                   Eval      Length = StringLim
     C                   Endif
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  GetMiiNbr:  Get the current MI Instruction number for line      *
      * ---------------------------------------------------------------- *
     C     GetMiiNbr     Begsr
      *
     C                   Exsr      SetUniTxt
      *
     C                   Eval      LineType   = *Blank
     C                   Eval      SfMiLvlIns = *Blank
     C                   Eval      TrMiI      = *Blank
      *
      *  Check for pending (spanned) DCL lines
      *
     C                   Exsr      ChkPndLin
      *
     C                   If        LineType = *Blank
      *
      *  First check if the Source line is entirely blank
      *
     C                   If        SrcDta = *Blank
     C                   Eval      LineType = BlnkLine
     C                   Else
      *
      *  Next, check if the Source line is a comment line
      *
     C     CommChar      Scan      TxtDta        Index                    77
     C                   If        Index > *Zero
     C                   Eval      LineType = CommLine
     C                   Else
      *
      *  Next, check if the Source line is a Declare line
      *
     C     DeclChar      Scan      TxtDta        Index                    77
     C                   If        Index > *Zero
     C                   Eval      LineType = DeclLine
     C                   Else
      *
      *  Next, check if the Source line is an *Entry line
      *
     C     EntrChar      Scan      TxtDta        Index                    77
     C                   If        Index > *Zero
     C                   Eval      LineType = EntrLine
     C                   Else
      *
      *  Last, check if the Source line is an Instruction
      *
     C     SemiChar      Scan      TxtDta        Index                    77
     C                   If        Index > *Zero
     C                   Eval      LineType = InstLine
     C                   Else
      *
      *  If none of the above, it is probably a Label line
      *
     C                   Eval      LineType = LablLine
     C                   Endif
     C                   Endif
     C                   Endif
     C                   Endif
     C                   Endif
     C                   Endif
      *
     C                   Exsr      ChkSpcTxt
      *
      *  If we have an Instruction line, increment MI number
      *
     C                   If        LineType  = InstLine
     C                   Eval      MiInsNbr  = MiInsNbr + 1
     C                   Eval      NxtInsNbr = MiInsNbr
     C                   Exsr      CvtHexChr
     C                   Eval      SfMiLvlIns = Slash + TrMiI
     C                   Endif
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  GetModAtr:  Get the basic Module attributes                     *
      * ---------------------------------------------------------------- *
     C     GetModAtr     Begsr
      *
     C                   Eval      TrName   =  Program
     C                   Eval      TrLibr   = '*LIBL'
      *
     C                   Eval      TrSrcMbr = '*N'
     C                   Eval      TrSrcObj = '*N'
     C                   Eval      TrSrcLib = '*N'
     C                   Eval      TrAttr   = '*N'
      *
      *  Get the Source information for the *MI module
      *
     C                   Call      'GETATR'
     C                   Parm                    TrName
     C                   Parm                    TrLibr
     C                   Parm                    TrSrcMbr
     C                   Parm                    TrSrcObj
     C                   Parm                    TrSrcLib
     C                   Parm                    TrAttr
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  GetPageBdy:  Get the current Page line boundaries               *
      * ---------------------------------------------------------------- *
     C     GetPageBdy    Begsr
      *
      *  Get the start and finish numbers for the Page
      *
     C                   Eval      Curr   = SflNbr
     C                   Eval      Last   = SflNbr + PagSiz - 1
      *
      *  Check that the last number is not past SFL boundary
      *
     C                   If        Last > EndRrn
     C                   Eval      Last = EndRrn
     C                   Endif
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  GetSrcDta:  Get the SFL source record for the Cursor            *
      * ---------------------------------------------------------------- *
     C     GetSrcDta     Begsr
      *
     C     Key           Chain     SFL                                77
      *
     C                   Eval      TrMiI = SfMiI
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  HandleBot:  Handle the "Bottom" command request                 *
      * ---------------------------------------------------------------- *
     C     HandleBot     Begsr
      *
     C                   Exsr      SetCmdVal
      *
     C                   Eval      SflNbr = EndRrn
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  HandleDn:  Handle the "Move down nnn lines" command request     *
      * ---------------------------------------------------------------- *
     C     HandleDn      Begsr
      *
     C                   Exsr      SetCmdVal
      *
     C                   Eval      Digits = *Zero
      *
      *  Set up the Mask for the CVTEFN MI instruction
      *
     C                   Eval      Mask = '$,.'
      *
     C                   Eval      First  = Index + ExecCmdSiz
     C                   Exsr      GetFirsChr
     C                   Eval      Start  = Next
     C                   Eval      Total  = Limit - Start + 1
     C                   If        Total  > *Zero
     C                   Eval      String = %Subst(Input:Start:Total)
      *
      *  Capture up to TEN numeric digits from String
      *
     C                   Exsr      GetLastChr
     C                   Eval      Index  = Length
     C                   Eval      ArrIdx = Ten
      *
     C                   DoU       Index = *Zero
     C                   If        ( StrArr(Index) = '0'   or
     C                               StrArr(Index) = '1'   or
     C                               StrArr(Index) = '2'   or
     C                               StrArr(Index) = '3'   or
     C                               StrArr(Index) = '4'   or
     C                               StrArr(Index) = '5'   or
     C                               StrArr(Index) = '6'   or
     C                               StrArr(Index) = '7'   or
     C                               StrArr(Index) = '8'   or
     C                               StrArr(Index) = '9' ) and
     C                             ArrIdx > *Zero
     C                   Eval      Digits(  ArrIdx) = StrArr(Index)
     C                   Eval      ArrIdx = ArrIdx - 1
     C                   Endif
     C                   Eval      Index = Index - 1
     C                   Enddo
      *
      *  Move the ten digits in array back to command string
      *
     C                   Eval      Length = TEN
     C                   Eval      String = *Zero
     C                   Do        Ten           Index
     C                   Eval      StrArr(Index) = Digits(Index)
     C                   Enddo
      *
      *  Convert numeric bytes in String into an integer
      *
     C                   Callp     CvtEfn(OutNumber:
     C                                    OutDesc:
     C                                    String:
     C                                    Length:
     C                                    Mask
     C                                    )
      *
      *  Move the SFL page index down OutNumber of lines
      *
     C                   If        OutNumber <= MaxSize
     C                   Eval      SflNbr = SflNbr + OutNumber
     C                   If        SflNbr > EndRrn
     C                   Eval      SflNbr = EndRrn
     C                   Endif
     C                   Endif
     C                   Endif
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  HandleEval:  Handle the "Evaluate variable" command request     *
      * ---------------------------------------------------------------- *
     C     HandleEval    Begsr
      *
     C                   Exsr      SetCmdVal
      *
      *  NOTE that InpLin (array) and StrArr (array) do the same thing
      *       and address the same memory; we could call it InpStr.
      *
     C                   Eval      Start = *Zero
     C                   Eval      Finis = *Zero
      *
      *  Get the Name of the variable to display
      *
     C                   Eval      HavePgmVar = *Off
      *
     C                   Eval      First  = Index + ExecCmdSiz
     C                   Exsr      GetFirsChr
     C                   Eval      Start  = Next
     C                   Eval      Total  = Limit - Start + 1
     C                   If        Total  > *Zero
     C                   Eval      String = %Subst(Input:Start:Total)
      *
     C                   Eval      Index = 1
      *
      *  Scan input Argument string for variable Name
      *
     C                   Eval      Start   = Index
      *
     C                   DoU       HavePgmVar = *On
     C                   If        InpLin(Index) = Space  or
     C                             InpLin(Index) = Comma  or
     C                             InpLin(Index) = SemiC
     C                   Eval      Finis = Index - 1
     C                   Exsr      SetEvalVar
     C                   Eval      HavePgmVar = *On
     C                   Leave
     C                   Else
     C                   If        Index = LineLimit
     C                   Leave
     C                   Else
     C                   Eval      Index = Index + 1
     C                   Endif
     C                   Endif
     C                   Enddo
     C                   Endif
      *
      *  If Total > zero, we know the Argument is valid or blank
      *
     C                   If        HavePgmVar = *On
     C                   Exsr      DsptheVar
     C                   Else
     C                   Exsr      DspError
     C                   Endif
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  HandleFind:  Handle the "Find String" command request           *
      * ---------------------------------------------------------------- *
     C     HandleFind    Begsr
      *
     C                   Exsr      SetCmdVal
      *
      *  Capture the "Find Text" argument into String
      *
     C                   Eval      First  = Index + ExecCmdSiz
     C                   Exsr      GetFirsChr
     C                   Eval      Start  = Next
     C                   Eval      Total  = Limit - Start + 1
     C                   If        Total  > *Zero
     C                   Eval      String = %Subst(Input:Start:Total)
      *
     C                   Exsr      GetLastChr
     C                   Exsr      GetCurrPos
      *
      *  Scan from last found line until we find search String
      *
     C     Curr          Do        EndRrn        Rrn
     C     Rrn           Chain     SFL                                77
     C                   Exsr      SetUniSrc
     C     String:Length Scan      TxSrc         Index                    77
     C                   If        Index > *Zero
     C                   Exsr      SavLasFnd
     C                   Exsr      SetSflKey
     C                   Leave
     C                   Endif
     C                   Enddo
     C                   Endif
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  HandlePos:  Handle the "Position to line" command request       *
      * ---------------------------------------------------------------- *
     C     HandlePos     Begsr
      *
     C                   Exsr      SetCmdVal
      *
     C                   Eval      Digits = *Zero
      *
      *  Set up the Mask for the CVTEFN MI instruction
      *
     C                   Eval      Mask = '$,.'
      *
     C                   Eval      First  = Index + ExecCmdSiz
     C                   Exsr      GetFirsChr
     C                   Eval      Start  = Next
     C                   Eval      Total  = Limit - Start + 1
     C                   If        Total  > *Zero
     C                   Eval      String = %Subst(Input:Start:Total)
      *
      *  Capture up to TEN numeric digits from String
      *
     C                   Exsr      GetLastChr
     C                   Eval      Index  = Length
     C                   Eval      ArrIdx = Ten
      *
     C                   DoU       Index = *Zero
     C                   If        ( StrArr(Index) = '0'   or
     C                               StrArr(Index) = '1'   or
     C                               StrArr(Index) = '2'   or
     C                               StrArr(Index) = '3'   or
     C                               StrArr(Index) = '4'   or
     C                               StrArr(Index) = '5'   or
     C                               StrArr(Index) = '6'   or
     C                               StrArr(Index) = '7'   or
     C                               StrArr(Index) = '8'   or
     C                               StrArr(Index) = '9' ) and
     C                             ArrIdx > *Zero
     C                   Eval      Digits(  ArrIdx) = StrArr(Index)
     C                   Eval      ArrIdx = ArrIdx - 1
     C                   Endif
     C                   Eval      Index = Index - 1
     C                   Enddo
      *
      *  Move the ten digits in array back to command string
      *
     C                   Eval      Length = TEN
     C                   Eval      String = *Zero
     C                   Do        Ten           Index
     C                   Eval      StrArr(Index) = Digits(Index)
     C                   Enddo
      *
      *  Convert numeric bytes in String into an integer
      *
     C                   Callp     CvtEfn(OutNumber:
     C                                    OutDesc:
     C                                    String:
     C                                    Length:
     C                                    Mask
     C                                    )
      *
      *  Set the SFL page index to specific line number
      *
     C                   If        OutNumber <= EndRrn  and
     C                             OutNumber >= 1
     C                   Eval      SflNbr = OutNumber
     C                   Endif
     C                   Endif
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  HandleSrcP:  Handle the "Single Source Page" command request    *
      * ---------------------------------------------------------------- *
     C     HandleSrcP    Begsr
      *
     C                   Exsr      SetCmdVal
      *
     C                   Eval      Index  = *Zero
     C                   Eval      LinArr = *Zero
     C                   Eval      TxtArr = *Blank
      *
      *  Capture the current Source file page data
      *
     C                   Exsr      GetPageBdy
      *
     C     Curr          Do        Last          Rrn
     C     Rrn           Chain     SFL                                77
     C                   Eval      Index = Index + 1
     C                   Eval      Lin(Index) = SfSeq
     C                   Eval      Txt(Index) = SfSrc
     C                   Enddo
      *
      *  Display the current Source file page data
      *
     C                   Exfmt     PNL
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  HandleText:  Handle the "Show Source Text" command request      *
      * ---------------------------------------------------------------- *
     C     HandleText    Begsr
      *
     C                   Exsr      SetCmdVal
      *
     C                   Eval      CmdText  = 'StrSeu'    + ' ' +
     C                                        'SrcFile'   +
     C                                         StrParan   + ' ' +
     C                                         Qualif     + ' ' +
     C                                         EndParan   + ' ' +
     C                                        'SrcMbr'    +
     C                                         StrParan   + ' ' +
     C                                         Member     + ' ' +
     C                                         EndParan   + ' ' +
     C                                         ViewOnly
     C                   Eval      CmdLen   =  %Size(CmdText)
      *
     C                   CallP     SysExecute(CmdText:
     C                                        CmdLen
     C                                        )
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  HandleTop:  Handle the "Top" command request                    *
      * ---------------------------------------------------------------- *
     C     HandleTop     Begsr
      *
     C                   Exsr      SetCmdVal
      *
     C                   Eval      SflNbr = 1
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  HandleUp:  Handle the "Move up nnn lines" command request       *
      * ---------------------------------------------------------------- *
     C     HandleUp      Begsr
      *
     C                   Exsr      SetCmdVal
      *
     C                   Eval      Digits = *Zero
      *
      *  Set up the Mask for the CVTEFN MI instruction
      *
     C                   Eval      Mask = '$,.'
      *
     C                   Eval      First  = Index + ExecCmdSiz
     C                   Exsr      GetFirsChr
     C                   Eval      Start  = Next
     C                   Eval      Total  = Limit - Start + 1
     C                   If        Total  > *Zero
     C                   Eval      String = %Subst(Input:Start:Total)
      *
      *  Capture up to TEN numeric digits from String
      *
     C                   Exsr      GetLastChr
     C                   Eval      Index  = Length
     C                   Eval      ArrIdx = Ten
      *
     C                   DoU       Index = *Zero
     C                   If        ( StrArr(Index) = '0'   or
     C                               StrArr(Index) = '1'   or
     C                               StrArr(Index) = '2'   or
     C                               StrArr(Index) = '3'   or
     C                               StrArr(Index) = '4'   or
     C                               StrArr(Index) = '5'   or
     C                               StrArr(Index) = '6'   or
     C                               StrArr(Index) = '7'   or
     C                               StrArr(Index) = '8'   or
     C                               StrArr(Index) = '9' ) and
     C                             ArrIdx > *Zero
     C                   Eval      Digits(  ArrIdx) = StrArr(Index)
     C                   Eval      ArrIdx = ArrIdx - 1
     C                   Endif
     C                   Eval      Index = Index - 1
     C                   Enddo
      *
      *  Move the ten digits in array back to command string
      *
     C                   Eval      Length = TEN
     C                   Eval      String = *Zero
     C                   Do        Ten           Index
     C                   Eval      StrArr(Index) = Digits(Index)
     C                   Enddo
      *
      *  Convert numeric bytes in String into an integer
      *
     C                   Callp     CvtEfn(OutNumber:
     C                                    OutDesc:
     C                                    String:
     C                                    Length:
     C                                    Mask
     C                                    )
      *
      *  Move the SFL page index back OutNumber of lines
      *
     C                   If        OutNumber <= MaxSize
     C                   Eval      SflNbr = SflNbr - OutNumber
     C                   If        SflNbr < 1
     C                   Eval      SflNbr = 1
     C                   Endif
     C                   Endif
     C                   Endif
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  HdlDbgCmd:  Handle a special Debugger command request           *
      * ---------------------------------------------------------------- *
     C     HdlDbgCmd     Begsr
      *
     C                   If        TrInp  > *Blank
      *
     C                   Exsr      SavLasCmd
     C                   Exsr      SetUniCas
     C                   Exsr      CheckAlias
      *
      *  Check for a valid command in the monocase input string
      *
     C     ExecBot       Scan      Input         Index                    77
     C                   If        Index  > *Zero
     C                   Exsr      HandleBot
     C                   Endif
     C     ExecDn        Scan      Input         Index                    77
     C                   If        Index  > *Zero
     C                   Exsr      HandleDn
     C                   Endif
     C     ExecEval      Scan      Input         Index                    77
     C                   If        Index  > *Zero
     C                   Exsr      HandleEval
     C                   Endif
     C     ExecFind      Scan      Input         Index                    77
     C                   If        Index  > *Zero
     C                   Exsr      HandleFind
     C                   Endif
     C     ExecPos       Scan      Input         Index                    77
     C                   If        Index  > *Zero
     C                   Exsr      HandlePos
     C                   Endif
     C     ExecSrcP      Scan      Input         Index                    77
     C                   If        Index  > *Zero
     C                   Exsr      HandleSrcP
     C                   Endif
     C     ExecText      Scan      Input         Index                    77
     C                   If        Index  > *Zero
     C                   Exsr      HandleText
     C                   Endif
     C     ExecTop       Scan      Input         Index                    77
     C                   If        Index  > *Zero
     C                   Exsr      HandleTop
     C                   Endif
     C     ExecUp        Scan      Input         Index                    77
     C                   If        Index  > *Zero
     C                   Exsr      HandleUp
     C                   Endif
      *
      *  If there is no valid command detected, inform the User
      *
     C                   If        DbgCmdVal = *Off
     C                   Exsr      DspError
     C                   Endif
     C                   Endif
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  HdlSfl:  Handle any SFL action requests                         *
      * ---------------------------------------------------------------- *
     C     HdlSfl        Begsr
      *
     C                   Exsr      RstError
     C                   Exsr      SetSflCur
      *
      *  Handle the "Add or remove Breakpoint" request
      *
     C                   If        ( InKey = BrkPRqs  and
     C                               Nam   = 'SFL'    and
     C                               Fld   = 'SFSRC'  and
     C                               Pos   > *Zero )
     C                   Exsr      AddRmvBkp
     C                   Endif
      *
      *  Handle the "Display this Variable" request
      *
     C                   If        ( InKey = DispRqs  and
     C                               Nam   = 'SFL'    and
     C                               Fld   = 'SFSRC'  and
     C                               Pos   > *Zero )
     C                   Exsr      DspPgmVar
     C                   Endif
      *
      *  Handle the "Display Command Line" request
      *
     C                   If        ( InKey = CommRqs  and
     C                               Nam   = 'CTL'    and
     C                               Fld   = 'TRINP'  and
     C                               Pos   > *Zero )
     C                   Exsr      DspCmdLin
     C                   Endif
      *
      *  Handle the "Execute this command" request
      *
     C                   If        ( InKey = ExecRqs  and
     C                               Nam   = 'CTL'    and
     C                               Fld   = 'TRINP'  and
     C                               Pos   > *Zero )
     C                   Exsr      HdlDbgCmd
     C                   Endif
      *
      *  Handle the "Run to Machine Instruction" request
      *
     C                   If        ( InKey = GotoRqs  and
     C                               Nam   = 'SFL'    and
     C                               Fld   = 'SFSRC'  and
     C                               Pos   > *Zero )
     C                   Exsr      RuntoInst
     C                   Endif
      *
      *  Handle the "Return to Home position" request
      *
     C                   If        ( InKey = HomeRqs  and
     C                               Nam   = 'CTL'    and
     C                               Fld   = 'TRINP'  and
     C                               Pos   > *Zero )
     C                   Exsr      RtnHomePos
     C                   Endif
      *
      *  Handle the "Repeat the last Command" request
      *
     C                   If        ( InKey = RpCmRqs  and
     C                               Nam   = 'CTL'    and
     C                               Fld   = 'TRINP'  and
     C                               Pos   > *Zero )
     C                   Exsr      RepeatCmd
     C                   Endif
      *
      *  Handle the "Repeat last FIND Comand" request
      *
     C                   If        ( InKey = RpFnRqs  and
     C                               Nam   = 'CTL'    and
     C                               Fld   = 'TRINP'  and
     C                               Pos   > *Zero )
     C                   Exsr      RepeatFnd
     C                   Endif
      *
      *  Handle the "Execute one Instruction" request
      *
     C                   If          InKey = StepRqs  and
     C                             ( Nam   = 'HDR'    or
     C                               Nam   = 'SFL'    or
     C                               Nam   = 'CTL' )
     C                   Exsr      SingleStep
     C                   Endif
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  Override:  Override with qualified Physical File member         *
      * ---------------------------------------------------------------- *
     C     Override      Begsr
      *
     C                   Eval      CmdText  = 'OvrDbf' + ' ' +
     C                                         File    + ' ' +
     C                                         Qualif  + ' ' +
     C                                         Member  + ' ' +
     C                                         Scope
     C                   Eval      CmdLen   =  %Size(CmdText)
      *
     C                   CallP     SysExecute(CmdText:
     C                                        CmdLen
     C                                        )
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  PutSflDta:  Edit SFL breakpoint and haltpoint attributes        *
      * ---------------------------------------------------------------- *
     C     PutSflDta     Begsr
      *
     C                   Exsr      SetBrkMrk
     C                   Exsr      SetHltMrk
      *
     C                   Update    SFL
      *
     C                   Exsr      RstSflAtr
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  RepeatCmd:  Copy the last command into Input buffer             *
      * ---------------------------------------------------------------- *
     C     RepeatCmd     Begsr
      *
     C                   Eval      TrInp = SavCommand
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  RepeatFnd:  Repeat the last "Find String" command               *
      * ---------------------------------------------------------------- *
     C     RepeatFnd     Begsr
      *
     C                   Eval      TrInp = SavFndCmd
      *
      *  Check for a valid command in the monocase input string
      *
     C                   If        TrInp > *Blank
     C                   Exsr      SetUniCas
     C     ExecFind      Scan      Input         Index                    77
     C                   If        Index > *Zero
     C                   Exsr      HandleFind
     C                   Endif
     C                   Endif
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  RmvBrkPnt:  Remove Breakpoint from MI instruction               *
      * ---------------------------------------------------------------- *
     C     RmvBrkPnt     Begsr
      *
     C                   Exsr      SetInsNbr
      *
      *  Action that is requested is to SUB a breakpoint
      *
     C                   Eval      CmdText  = 'RmvBkp'    + ' ' +
     C                                         StrParan   + ' ' +
     C                                         Instruct   + ' ' +
     C                                         EndParan   + ' ' +
     C                                         DftPgm
     C                   Eval      CmdLen   =  %Size(CmdText)
      *
      *  Execute the indicated RMVBKP command for breakpoint
      *
     C                   CallP     SysExecute(CmdText:
     C                                        CmdLen
     C                                        )
      *
     C                   Eval      BrkPntSet = *Off
     C                   Eval      ModHltPnt = SfHlt
      *
     C                   Endsr
      *------------------------------------------------------------------*
      *  RstCmdVal:  Reset the Debug Command valid switch to OFF         *
      *------------------------------------------------------------------*
     C     RstCmdVal     Begsr
      *
     C                   Eval      DbgCmdVal = *Off
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  RstDbgSts:  Reset Debug status to "NOT in Step mode"            *
      * ---------------------------------------------------------------- *
     C     RstDbgSts     Begsr
      *
      *  Get the input instruction from Entry parameter
      *
     C                   If        StepMode = *On
      *
     C                   Exsr      GetEntVal
     C                   Exsr      RmvBrkPnt
      *
     C                   Eval      StepMode = *Off
      *
     C                   Endif
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  RstError:  Reset the Erorr status fields                        *
      * ---------------------------------------------------------------- *
     C     RstError      Begsr
      *
     C                   Eval      *In99  = *Off
     C                   Eval      Mic    = *Blank
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  RstSflAtr:  Reset the various SFL flags and attributes          *
      *----------------------------------------------------------------- *
     C     RstSflAtr     Begsr
      *
      * Reset the "BreakPoint is set" and "Halt Point" flags
      *
     C                   Eval      BrkPntSet = *Off
     C                   Eval      ModHltPnt = *Off
     C                   Eval      SfHlt     = *Off
      *
      * Reset the "BreakPoint Mark" and "Halt Point" attributes
      *
     C                   Eval      SfBrk = *Blank
     C                   Eval      A     = NormalAtr
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  RtnHomePos:  Return to the HOME (top) position                  *
      * ---------------------------------------------------------------- *
     C     RtnHomePos    Begsr
      *
     C                   Eval      SflNbr = 1
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  RtvSrc:  Retrieve the MI Source program into SFL                *
      * ---------------------------------------------------------------- *
     C     RtvSrc        Begsr
      *
     C                   Exsr      ClrSflData
      *
      *  Read all the Source records into SFL
      *
     C     *Start        SetLL     Src
      *
     C                   Read      Src           $Src                     77
      *
     C                   DoW       *In77 = *Off
     C                   Exsr      GetMiiNbr
     C                   Eval      SfSeq = SrcSeq
     C                   Eval      SfMiI = TrMiI
     C                   Eval      SfSrc = SrcDta
     C                   Eval      Rrn   = Rrn + 1
     C                   Eval      *In02 = *On
     C                   Exsr      SetBrkAtr
     C                   Exsr      SetHltAtr
     C                   Exsr      WrtSflDta
     C                   Read      Src           $Src                     77
     C                   Enddo
      *
     C                   Eval      EndRrn = Rrn
      *
      *  Adjust the SFL page key and then reset Step status
      *
     C                   Exsr      AdjPagKey
     C                   Exsr      RstDbgSts
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  RuntoInst:  Execute the program up to this instruction          *
      * ---------------------------------------------------------------- *
     C     RuntoInst     Begsr
      *
     C                   Exsr      GetSrcDta
      *
      *  If source line represents an instruction, set breakpoint
      *
     C                   If        SfMiI <> *Blank
     C                   Eval      TrMiI = SfMiI
     C                   Exsr      AddBrkPnt
     C                   Exsr      SetDbgSts
     C                   Endif
      *
     C                   Return
      *
     C                   Endsr
      *------------------------------------------------------------------*
      *  SavLasCmd:  Save the last command request entered               *
      *------------------------------------------------------------------*
     C     SavLasCmd     Begsr
      *
     C                   If        TrInp > *Blank
     C                   Eval      SavCommand = TrInp
     C                   Endif
      *
     C                   Endsr
      *------------------------------------------------------------------*
      *  SavLasFnd:  Save the last "Find" command request                *
      *------------------------------------------------------------------*
     C     SavLasFnd     Begsr
      *
     C                   Eval      SavFndCmd  = Input
     C                   Eval      SavFndNbr  = Rrn
      *
     C                   Endsr
      *------------------------------------------------------------------*
      *  SetBrkAtr:  Set the SFL source line *BRK attribute              *
      *------------------------------------------------------------------*
     C     SetBrkAtr     Begsr
      *
     C                   If        SfMiI > *Blank
     C     SfMiI         Lookup    MiInst                                 77
     C                   If        *In77 = *On
     C                   Eval      BrkPntSet = *On
     C                   Endif
     C                   Endif
      *
     C                   Endsr
      *------------------------------------------------------------------*
      *  SetBrkMrk:  Set the "permanent" Breakpoint mark if needed       *
      *------------------------------------------------------------------*
     C     SetBrkMrk     Begsr
      *
      *  If BrkPntSet is OFF, reset to normal to show no breakpoint
      *
     C                   If        BrkPntSet = *Off
     C                   Eval      SfBrk = *Blank
     C                   Endif
      *
      *  If BrkPntSet is ON, set break mark to show the breakpoint
      *
     C                   If        BrkPntSet = *On
     C                   Eval      SfBrk = BreakMark
     C                   Endif
      *
     C                   Endsr
      *------------------------------------------------------------------*
      *  SetCmdVal:  Set the Debug Command valid switch to ON            *
      *------------------------------------------------------------------*
     C     SetCmdVal     Begsr
      *
     C                   Eval      DbgCmdVal = *On
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  SetDbgSts:  Set Debug status to "in Step mode" if needed        *
      * ---------------------------------------------------------------- *
     C     SetDbgSts     Begsr
      *
     C     TrMiI         Lookup    MiInst                                 77
      *
     C                   Eval      StepMode = not (*In77)
      *
     C                   Endsr
      *------------------------------------------------------------------*
      *  SetDspNam:  Set the Display source object names                 *
      *------------------------------------------------------------------*
     C     SetDspNam     Begsr
      *
     C                   Eval      TrFile = TrSrcObj
     C                   Eval      TrLib  = TrSrcLib
     C                   Eval      TrMbr  = TrSrcMbr
      *
     C                   Endsr
      *------------------------------------------------------------------*
      *  SetEdtVal:  Set value for "Convert External Format to Numeric"  *
      *------------------------------------------------------------------*
     C     SetEdtVal     Begsr
      *
      *  Set up the Mask for the CVTEFN instruction
      *
     C                   Eval      Mask   = '$,.'
     C                   Eval      String = '99,999,999'
     C                   Eval      Length =  Ten
      *
      *  Set up the output numeric scalar description
      *
     C                   Eval      ScalarType = X'00'
     C                   Eval      ScalarLen  = X'0004'
     C                   Eval      Reserved   = *AllX'00'
     C                   Eval      OutDesc = Descript
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  SetEvalVar:  Set Program variable from the input String         *
      * ---------------------------------------------------------------- *
     C     SetEvalVar    Begsr
      *
     C                   Eval      Total = 1
      *
      *  Note that MI variable names are up to thirty characters
      *
     C                   If        Finis >  Start
     C                   Eval      Total = (Finis - Start) + 1
     C                   Endif
      *
     C                   Eval      Variable = %Subst(String:Start:Total)
      *
     C                   Endsr
      *------------------------------------------------------------------*
      *  SetHltAtr:  Set the SFL source line HALT attribute              *
      *------------------------------------------------------------------*
     C     SetHltAtr     Begsr
      *
     C                   If        SfMiLvlIns = HiLvlIns  and
     C                             SfMiLvlIns > *Blank
     C                   Eval      ModHltPnt  = *On
     C                   Eval      SflNbr = Rrn
     C                   Endif
      *
     C                   Endsr
      *------------------------------------------------------------------*
      *  SetHltMrk:  Set the high intensity display attribute            *
      *------------------------------------------------------------------*
     C     SetHltMrk     Begsr
      *
      *  If ModHltPnt is OFF, reset to normal to show no breakpoint
      *
     C                   If        ModHltPnt = *Off
     C                   Eval      SfHlt = *Off
     C                   Eval      A = NormalAtr
     C                   Endif
      *
      *  If ModHltPnt is ON, set high intensity to show breakpoint
      *
     C                   If        ModHltPnt = *On
     C                   Eval      SfHlt = *On
     C                   Eval      A = IntensAtr
     C                   Endif
      *
     C                   Endsr
      *------------------------------------------------------------------*
      *  SetInpNam:  Set the input file qualified name                   *
      *------------------------------------------------------------------*
     C     SetInpNam     Begsr
      *
     C                   Eval      InpFile = %Trim(TrSrcLib) +
     C                                       %Trim(Slash)  +
     C                                       %Trim(TrSrcObj)
      *
     C                   Eval      Member  = TrSrcMbr
      *
     C                   Endsr
      *------------------------------------------------------------------*
      *  SetInsNbr:  Set the Instruction number for ADDBKP               *
      *------------------------------------------------------------------*
     C     SetInsNbr     Begsr
      *
     C                   Eval      Instruct = Quote +
     C                                        Slash +
     C                                        TrMiI +
     C                                        Quote
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  SetPgmVar:  Set Program variable from scanned Source line       *
      * ---------------------------------------------------------------- *
     C     SetPgmVar     Begsr
      *
     C                   Eval      Total = 1
      *
      *  Note that MI variable names are up to thirty characters
      *
     C                   If        Finis >  Start
     C                   Eval      Total = (Finis - Start) + 1
     C                   Endif
      *
     C                   Eval      Variable = %Subst(SfSrc:Start:Total)
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  SetRcvDta:  Set the Message File and Message-Id data            *
      * ---------------------------------------------------------------- *
     C     SetRcvDta     Begsr
      *
     C                   Eval      MsgFmt = 'RCVM0100'
     C                   Eval      Action = '*OLD'
      *
     C                   Endsr
      *------------------------------------------------------------------*
      *  SetRqsAtr:  Set "Request Handler" attribute for this module     *
      *------------------------------------------------------------------*
     C     SetRqsAtr     Begsr
      *
     C                   Exsr      SetSndDta
      *
      *  Send a Request Message to this program's Message queue
      *
     C                   Call      'QMHSNDPM'
     C                   Parm                    MsgId
     C                   Parm                    MsgF
     C                   Parm      ReqsText      MsgDta
     C                   Parm      75            MsgLen
     C                   Parm      '*RQS'        MsgTyp
     C                   Parm      '*'           StkEnt
     C                   Parm      0             StkCnt
     C                   Parm                    MsgKey
     C                   Parm                    Error
      *
     C                   Exsr      SetRcvDta
      *
      *  Read a Request Message on this program's Message queue
      *
     C                   Call      'QMHRCVPM'
     C                   Parm                    MsgDta
     C                   Parm      75            MsgLen
     C                   Parm                    MsgFmt
     C                   Parm      '*'           StkEnt
     C                   Parm      0             StkCnt
     C                   Parm      '*RQS'        MsgTyp
     C                   Parm                    MsgKey
     C                   Parm      0             MsgWait
     C                   Parm                    Action
     C                   Parm                    Error
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  SetSflCur:  Set the SFL page pointer current values             *
      * ---------------------------------------------------------------- *
     C     SetSflCur     Begsr
      *
     C                   If        InSfPP    > *Zero
     C                   Eval      SflNbr    = InSfPP
     C                   Eval      PrvTopKey = SflNbr
     C                   Eval      PrvBotKey = SflNbr + PagSiz - 1
     C                   If        PrvBotKey > EndRrn
     C                   Eval      PrvBotKey = EndRrn
     C                   Endif
     C                   Endif
      *
     C                   Endsr
      *------------------------------------------------------------------*
      *  SetSflKey:  Set the SFL page pointer for found string           *
      *------------------------------------------------------------------*
     C     SetSflKey     Begsr
      *
     C                   Eval      SflNbr = Rrn
      *
      *  Adjust the number by one upward if we are not at BOF
      *
     C                   If        SflNbr > 1
     C                   Eval      SflNbr = SflNbr - 1
     C                   Endif
      *
     C                   Eval      SavKeyNbr = SflNbr
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  SetSndDta:  Set the Message File and Message-Id data            *
      * ---------------------------------------------------------------- *
     C     SetSndDta     Begsr
      *
     C                   Eval      MsgF  = *Blank
     C                   Eval      MsgId = *Blank
      *
     C                   Endsr
      *------------------------------------------------------------------*
      *  SetUniCas:  Set the Debug Command to UniCase Text               *
      *------------------------------------------------------------------*
     C     SetUniCas     Begsr
      *
      *  Translate the entire input line to UniCase for MI source
      *
     C     Lower:Upper   Xlate     TrInp         Input
      *
     C                   Eval      TrInp = *Blank
      *
     C                   Endsr
      *------------------------------------------------------------------*
      *  SetUniSrc:  Set the input Source to UniCase Text                *
      *------------------------------------------------------------------*
     C     SetUniSrc     Begsr
      *
     C     Lower:Upper   Xlate     SfSrc         TxSrc
      *
     C                   Endsr
      *------------------------------------------------------------------*
      *  SetUniTxt:  Set the input Source to UniCase Text                *
      *------------------------------------------------------------------*
     C     SetUniTxt     Begsr
      *
     C     Lower:Upper   Xlate     SrcDta        TxtDta
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  SingleStep:  Step execution to the next MI instruction          *
      * ---------------------------------------------------------------- *
     C     SingleStep    Begsr
      *
     C                   Exsr      GetEntVal
      *
      *  Get the input instruction from Entry parameter
      *
     C                   Eval      TrMiI = EntryValue
      *
     C                   Exsr      CvtChrHex
      *
     C                   Eval      NxtInsNbr = NxtInsNbr + 1
      *
     C                   Exsr      CvtHexChr
      *
      *  Indicate that we are in Step mode for breakpoint
      *
     C                   Exsr      AddBrkPnt
     C                   Exsr      SetDbgSts
      *
     C                   Return
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  SndEndRqs:  Send an EndRqs message to previous Rqs Handler      *
      * ---------------------------------------------------------------- *
     C     SndEndRqs     Begsr
      *
     C                   Eval      CmdText  = 'EndRqs'    + ' ' +
     C                                         RqsLvl
     C                   Eval      CmdLen   =  %Size(CmdText)
      *
     C                   CallP     SysExecute(CmdText:
     C                                        CmdLen
     C                                        )
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  Terminate:  Terminate the Debugger and return to Caller         *
      * ---------------------------------------------------------------- *
     C     Terminate     Begsr
      *
     C                   If        MiLvlIns > *Blank  and
     C                             InKey = ExitRqs
     C                   Exsr      SndEndRqs
     C                   Eval      *Inlr = *On
     C                   Else
     C                   Return
     C                   Endif
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  WrtSflDta:  Write the SFL attributes along with the SFL data    *
      * ---------------------------------------------------------------- *
     C     WrtSflDta     Begsr
      *
     C                   Exsr      SetBrkMrk
     C                   Exsr      SetHltMrk
      *
     C                   Write     SFL
      *
     C                   Exsr      RstSflAtr
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  This program is the exclusive property of Mosaic, Inc.          *
      *  No portion of this code may be reproduced for any reason        *
      *  without the express written permission of Mosaic, Inc.          *
      * ---------------------------------------------------------------- *
      *  SYSEXECUTE:  Execute a System Command with error checking       *
      * ---------------------------------------------------------------- *
     P SysExecute      B
      *
     D                 PI
     D CmdText                      256A
     D CmdLen                        15P 5
      * ---------------------------------------------------------------- *
      *  MAIN-LINE:                                                      *
      * ---------------------------------------------------------------- *
     C     Main          Tag
      *
     C                   Exsr      ClearSts
     C                   Exsr      Override
      *
     C                   Return
      * ---------------------------------------------------------------- *
      *  ClearSts:  Clear the Error status variables                     *
      * ---------------------------------------------------------------- *
     C     ClearSts      Begsr
      *
     C                   Eval      *In99  = *Off
     C                   Eval      Mic    = *Blank
     C                   Eval      StMsPf = *Blank
     C                   Eval      StMsNo = *Blank
     C                   Eval      StData = *Blank
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  GetMsgId:  Get the error Message Id from Status data            *
      * ---------------------------------------------------------------- *
     C     GetMsgId      Begsr
      *
     C                   Eval      %Subst(ErrMsgId:1:3) = StMsPf
     C                   Eval      %Subst(ErrMsgId:4:4) = StMsNo
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  Override:  Override the Source file to run-time value           *
      * ---------------------------------------------------------------- *
     C     Override      Begsr
      *
     C                   Call      'QCMDEXC'
     C                   Parm                    CmdText
     C                   Parm                    CmdLen
      *
     C                   Endsr
      * ---------------------------------------------------------------- *
      *  *Pssr:  Handle Program Error Status                             *
      * ---------------------------------------------------------------- *
     C     *Pssr         Begsr
      *
     C                   Exsr      GetMsgId
      *
     C                   Select
     C                   When      ErrMsgId = CmdError
     C                   Eval      *In99   = *On
     C                   Eval      Mic     = '0594'
     C                   When      ErrMsgId = SpcError
     C                   Eval      *In99   = *On
     C                   Eval      Mic     = '0594'
     C                   Endsl
      *
     C                   Return
      *
     C                   Endsr
     P SysExecute      E
      * ---------------------------------------------------------------- *
      *  WORKING-STORAGE TABLES:                                         *
      * ---------------------------------------------------------------- *

As an Amazon Associate we earn from qualifying purchases.

This thread ...

Follow-Ups:
Replies:

Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2022 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.