|
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;
midrange.com
/* ---------------------------------------------------------------- */
/* 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 mailing list archive is Copyright 1997-2024 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.
