By adding new keywords to the command, you can trim any leading character.
In the previous article, "Going Where No Substring (%SST) Operation Can Go," we saw what the Trim Left Characters (TRMLFTCHR) command can do through the use of pointers:
- Trim any leading zeros from a character string of any length that contains a non-negative numeric value
- Left-adjust the remaining value within the string
- Pad the string with blanks to its declared length
Today, we will see what is required to use TRMLFTCHR to do the same thing with any given leading character of any character string.
First, we need to add two new parameters to the TRMLFTCHR command.
The first parameter specifies what leading character should be trimmed from the command's VAR variable value if it's encountered. We'll identify this parameter with the keyword TRMCHR (for Trim Character) and define a default value of '0'. This default value is selected for compatibility with earlier versions of the command.
The second parameter specifies what value should be used if the input VAR character string is entirely comprised of the character specified for the TRMCHR keyword. The TRMLFTCHR CPP previously was hardcoded such that, if all zeros were found in the VAR input character string, the returned result would be a single character '0' padded with blanks. This, while OK for decimal values, may not be appropriate for any arbitrary character string that the command might process. We'll identify this parameter with the keyword ALLTRMCHR and define a default value of *TRMCHR. Using this default value will indicate to the command CPP that a single occurrence of the TRMCHR value should be used for the returned character string when no significant characters are found while processing the VAR variable. That is, if we're trimming zeros, then return one zero; if we're trimming asterisks, then return one asterisk; if we're trimming blanks, then return one blank (admittedly, then padded with blanks so it might be hard to "see"). If the user specifies a non-default value for ALLTRMCHR, then a single occurrence of the specified character, blank padded, will be placed in the returned result.
The new command definition source is shown below.
Cmd Prompt('Trim Left Characters')
Parm Kwd(Var) Type(*Char) Len(1) RtnVal(*Yes) +
Min(1) Vary(*Yes *Int4) +
Prompt('Decimal value')
Parm Kwd(TrmChr) Type(*Char) Len(1) Dft(0) +
Prompt('Character to trim')
Parm Kwd(AllTrmChr) Type(*Char) Len(1) +
Dft(*TrmChr) SpcVal((*TRMCHR X'FF')) +
Prompt('Character for all trimmed')
The definition for the VAR parameter remains the same as with the previous definition. The TRMCHR parameter is defined as a character value with a length of 1, defaulting to the value of 0. The new ALLTRMCHR parameter is defined as a character value with a length of 1, defaulting to *TRMCHR. As the default value of *TRMCHR exceeds the length of the parameter, the SPCVAL (Special value) keyword is used to map the value *TRMCHR to the 1-byte character value x'FF'. The decision to use this value (x'FF') is somewhat—but not completely—arbitrary, with my rationale not being pertinent to this article other than it's unlikely that you will have character data containing a leading x'FF' value.
To create the new version of the TRMLFTCHR command, you can use the same CRTCMD command that was used in previous articles:
CRTCMD CMD(TRMLFTCHR) PGM(TRMLFTCHR) ALLOW(*IPGM *BPGM *IMOD *BMOD)
As we've added two new parameters to the command, we also need to update the TRMLFTCHR CPP. The updated version of the TRMLFTCHR program is shown below.
Pgm Parm(&Char_Parm &TrmChr &All_TrmChr)
Dcl Var(&Char_Parm) Type(*Char) Len(5)
Dcl Var(&Char_Siz) Type(*Int) Stg(*Defined) +
DefVar(&Char_Parm 1)
Dcl Var(&First_Char) Type(*Char) Len(1) +
Stg(*Defined) DefVar(&Char_Parm 5)
Dcl Var(&TrmChr) Type(*Char) Len(1)
Dcl Var(&All_TrmChr) Type(*Char) Len(1)
Dcl Var(&Char_Ptr) Type(*Ptr)
Dcl Var(&Char) Type(*Char) Len(1) +
Stg(*Based) BasPtr(&Char_Ptr)
Dcl Var(&CharTgtPtr) Type(*Ptr)
Dcl Var(&Char_Tgt) Type(*Char) Len(1) +
Stg(*Based) BasPtr(&CharTgtPtr)
Dcl Var(&Char_Pos) Type(*UInt)
Dcl Var(&Char_Rem) Type(*UInt)
Dcl Var(&XFF) Type(*Char) Len(1) Value(x'FF')
ChgVar Var(&Char_Ptr) Value(%addr(&First_Char))
ChgVar Var(&CharTgtPtr) Value(%addr(&First_Char))
DoFor Var(&Char_Pos) From(1) To(&Char_Siz)
If Cond(&Char *EQ &TrmChr) Then(Do)
ChgVar Var(%ofs(&Char_Ptr)) Value(%ofs(&Char_Ptr) + 1)
Iterate
EndDo
Else Cmd(Leave)
EndDo
If Cond(&Char_Pos *LE &Char_Siz) Then(Do)
DoFor Var(&Char_Pos) From(&Char_Pos) To(&Char_Siz)
ChgVar Var(&Char_Tgt) Value(&Char)
ChgVar Var(%ofs(&CharTgtPtr)) +
Value(%ofs(&CharTgtPtr) + 1)
ChgVar Var(%ofs(&Char_Ptr)) +
Value(%ofs(&Char_Ptr) + 1)
EndDo
If Cond(&Char_Ptr *NE &CharTgtPtr) Then(Do)
ChgVar Var(&Char_Rem) +
Value(%ofs(&Char_Ptr) - %ofs(&CharTgtPtr))
DoFor Var(&Char_Pos) From(1) To(&Char_Rem)
ChgVar Var(&Char_Tgt) Value(' ')
ChgVar Var(%ofs(&CharTgtPtr)) +
Value(%ofs(&CharTgtPtr) + 1)
EndDo
EndDo
EndDo
Else Cmd(Do)
If Cond(&All_TrmChr *EQ &XFF) Then( +
ChgVar Var(&Char_Tgt) Value(&TrmChr))
Else Cmd( +
ChgVar Var(&Char_Tgt) Value(&All_TrmChr))
ChgVar Var(%ofs(&CharTgtPtr)) +
Value(%ofs(&CharTgtPtr) + 1)
DoFor Var(&Char_Pos) From(2) To(&Char_Siz)
ChgVar Var(&Char_Tgt) Value(' ')
ChgVar Var(%ofs(&CharTgtPtr)) +
Value(%ofs(&CharTgtPtr) + 1)
EndDo
EndDo
EndPgm
The changes needed for the TRMLFTCHR program are fairly minor:
- Change the PGM PARM keyword to indicate that three parameters are now being passed. The parameters are passed in the same sequence as the PARM commands are found in the command definition.
Parm(&Char_Parm)
becomes
Parm(&Char_Parm &TrmChr &All_TrmChr)
- Declare the two new parameters.
Dcl Var(&TrmChr) Type(*Char) Len(1)
Dcl Var(&All_TrmChr) Type(*Char) Len(1)
- Declare the variable &XFF, which will be set to the value x'FF' for subsequent comparison with the parameter &All_TrmChr.
Dcl Var(&XFF) Type(*Char) Len(1) Value(x'FF')
- Change the hardcoded test for a leading zero to a test for the user-specified &TrmChr variable value.
If Cond(&Char *EQ '0') Then(Do)
becomes
If Cond(&Char *EQ &TrmChr) Then(Do)
- Change the logic for when no significant characters are found in the input string to test for the special value *TRMCHR (passed to the CPP as x'FF') and set the resulting character string to the appropriate user-specified value.
ChgVar Var(&Char_Tgt) Value('0')
becomes
If Cond(&All_TrmChr *EQ &XFF) Then( +
ChgVar Var(&Char_Tgt) Value(&TrmChr))
Else Cmd( +
ChgVar Var(&Char_Tgt) Value(&All_TrmChr))
To compile the new CPP use either of the following commands:
CRTBNDCL PGM(TRMLFTCHR)
CRTCLPGM PGM(TRMLFTCHR)
As mentioned in the earlier article, "Going Where No Substring (%SST) Operation Can Go," if you are using the CRTBNDCL command to create an ILE program, make sure that you have the following PTFs applied to your system prior to compiling the CPP:
- V5R4—SI39398
- V6R1—SI39405
- V7R1—SI39407
To test the latest version of the TRMLFTCHR command, you can use the following CL test program.
Pgm
Dcl Var(&Char10) Type(*Char) Len(10)
Dcl Var(&Char50) Type(*Char) Len(50)
ChgVar Var(&Char10) Value(12.34)
SndPgmMsg Msg('Originally' *BCat &Char10)
TrmLftChr Var(&Char10)
SndPgmMsg Msg('Now.......' *BCat &Char10)
ChgVar Var(&Char10) Value(0)
SndPgmMsg Msg('Originally' *BCat &Char10)
TrmLftChr Var(&Char10) AllTrmChr('?')
SndPgmMsg Msg('Now.......' *BCat &Char10)
ChgVar Var(&Char10) Value(0)
SndPgmMsg Msg('Originally' *BCat &Char10)
TrmLftChr Var(&Char10)
SndPgmMsg Msg('Now.......' *BCat &Char10)
ChgVar Var(&Char10) Value('***ABC EF')
SndPgmMsg Msg('Originally' *BCat &Char10)
TrmLftChr Var(&Char10)
SndPgmMsg Msg('Now.......' *BCat &Char10)
ChgVar Var(&Char10) Value('***ABC EF')
SndPgmMsg Msg('Originally' *BCat &Char10)
TrmLftChr Var(&Char10) TrmChr(*)
SndPgmMsg Msg('Now.......' *BCat &Char10)
ChgVar Var(&Char50) Value(' ABCDEF')
SndPgmMsg Msg('Originally' *BCat &Char50)
TrmLftChr Var(&Char50) TrmChr(' ')
SndPgmMsg Msg('Now.......' *BCat &Char50)
EndPgm
When the test program is run, you should see the following messages, which demonstrate various combinations of the three command parameters.
Originally 0000012.34
Now....... 12.34
Originally 0000000000
Now....... ?
Originally 0000000000
Now....... 0
Originally ***ABC EF
Now....... ***ABC EF
Originally ***ABC EF
Now....... ABC EF
Originally ABCDEF
Now....... ABCDEF
But what if the CL program using TRMLFTCHR is reading a file, say, created by CPYSPLF, and encounters a report value of " *1.23" (five blanks, an asterisk, and then the four characters 1.23) that needs to be formatted as simply 1.23 within the CL application program? In this case, we want to remove any combination of two different leading characters: blanks and asterisks. In the next article, we'll do just that. The next version of the TRMLFTCHR command will demonstrate how a user command can support the TRMCHR command parameter as a list of values.
Answer to Last Month's Program Puzzler
In the previous article, I presented a puzzle question: "Can you think of a way to eliminate the need for these DOFORs that are updating the input character string with a predetermined number of blank characters?" I suggested that you review the "Understanding the CHKKILL Program" article published in February of 2009. What you would have found in the article was a discussion of the Machine Interface (MI) Propagate Byte (PROPB) instruction. This instruction, documented here, copies a given byte value (for instance, a blank) a user-specified number of times to a variable location. Using the Propagate Byte instruction, you can eliminate the two DOFOR loops that are found in the TRMLFTCHR CPP.
The first DOFOR loop…
DoFor Var(&Char_Pos) From(1) To(&Char_Rem)
ChgVar Var(&Char_Tgt) Value(' ')
ChgVar Var(%ofs(&CharTgtPtr)) +
Value(%ofs(&CharTgtPtr) + 1)
EndDo
…can be replaced with this statement:
CallPrc Prc('_PROPB') Parm((&Char_Tgt) +
(' ' *ByVal) (&Char_Rem *ByVal))
The second loop…
DoFor Var(&Char_Pos) From(2) To(&Char_Siz)
ChgVar Var(&Char_Tgt) Value(' ')
ChgVar Var(%ofs(&CharTgtPtr)) +
Value(%ofs(&CharTgtPtr) + 1)
EndDo
…can, in a similar fashion, be replaced with the two following statements:
ChgVar Var(&Char_Rem) Value(&Char_Siz - 1)
CallPrc Prc('_PROPB') Parm((&Char_Tgt) +
(' ' *ByVal) (&Char_Rem *ByVal))
Not only does the PROPB MI instruction allow us to type less CL source, it also runs faster than looping through the character string variable one byte at a time.
The TRMLFTCHR CPP examples used in this series of articles will continue to use the DOFOR implementations. Using DOFORs allows you to create the CPP as either an OPM program, using CRTCLPGM, or an ILE program, using CRTBNDCL. Imbedding MI instructions such as Propagate Byte directly into the CL source, on the other hand, can only be done with ILE CL.
More CL Questions?
Wondering how to accomplish a function in CL? Send your CL-related questions to me at
LATEST COMMENTS
MC Press Online