Push and Pop Library List Commands
A long time ago, in the S/38 days (mid 80’s), I had a need to save my current library list, do some work, then restore it. I wrote two commands to accomplish this using a stack.
One of the often-overlooked strengths of the i is that old and useful code doesn’t need to be discarded, but can continue to serve as-is or be easily updated.
These two commands are a perfect, if simple, example. Current versions can always be found in this Git Repository.
CMD PROMPT('Push Library List')
PARM KWD(DTAQ) TYPE(*NAME) LEN(10) DFT($LIBLSTACK) MIN(0) PROMPT('Data +
queue for LIBL stack')
PARM KWD(FNTYPE) TYPE(*CHAR) LEN(1) CONSTANT('P')
Code language: PHP (php)/******************************************************************************+
* Program: PSHLIBLC - CPP for the PSHLIBL Command +
* Save (Push) the library list to the qtemp Stack +
* Author: George Alderton +
* Written: 09-Sep-2020 +
* --------------------------------------------------------------------------- +
* Parms: &DtaQ - The name of the QTEMP Data Queue containing the stack +
* &Function - (P)ush - Save the LIBL to the QTEMP Stack Data Area +
* - (S)ave - Clear the QTEMP Data Area tjem Save the LIBL _+
* Data Area holds only one LIBL +
* --------------------------------------------------------------------------- +
* M O D I F I C A T I O N L O G +
* --------------------------------------------------------------------------- +
* Date Pgmr Description +
* -------- ---- --------------------------------------------------------- +
* 11Sep20 GAA Created +
* ****************************************************************************/
/* ****************************************************************************+
* Copyright (c) 2020 George Alderton, Walkingstick Software. LLC +
* All rights reserved. +
* +
* Redistribution and use in source and binary forms, with or without +
* modification, are permitted provided that the following conditions +
* are met: +
* 1. Redistributions of source code must retain the above copyright +
* notice, this list of conditions and the following disclaimer. +
* 2. Redistributions in binary form must reproduce the above copyright +
* notice, this list of conditions and the following disclaimer in the +
* documentation and/or other materials provided with the distribution. +
* +
* THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ''AS IS'' AND +
* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +
* ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE +
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +
* LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +
* OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +
* SUCH DAMAGE. +
******************************************************************************/
Pgm (&DtaQ &Function)
Dcl &DtaQ *Char 10
DCL &Function *Char 1 /* (P)ush (S)ave */
Dcl &UsrLibl *Char 2750
Dcl &CurLib *Char 10
/* Create data queue, if it does not already exist */
ChkObj QTEMP/&DtaQ *DtaQ
MonMsg CPF9801 Exec(CrtDtaQ QTEMP/&DtaQ MaxLen(2750) Seq(*LIFO))
/* Get current library list and current library */
RtvJobA UsrLibl(&UsrLibl) CurLib(&CurLib)
If (&CurLib = '*NONE ') Then(ChgVar &CurLib '*CRTDFT ')
/* If we're saving (not pushing), clear the data queue */
If (&Function = 'S') Then(Call QCLRDTAQ (&DTAQ QTEMP) )
/* Push data into stack (library list, then current library; +
they will be retrieved in reverse order */
Call QSndDtaQ (&DtaQ QTEMP X'02750F' &UsrLibl)
Call QSndDtaQ (&DtaQ QTEMP X'00010F' &CurLib)
EndPgm
Code language: PHP (php) CMD PROMPT('Pop Library List')
PARM KWD(DTAQ) TYPE(*NAME) LEN(10) DFT($LIBLSTACK) MIN(0) PROMPT('Data +
queue for LIBL stack')
PARM KWD(FNTYPE) TYPE(*CHAR) LEN(1) CONSTANT(P)
Code language: PHP (php)/******************************************************************************+
* Program: POPLIBLC - CPP for the POPLIBL Command +
* Restore (pop) a library list from the qtemp stack +
* Author: George Alderton +
* Written: 09-Sep-2020 +
* --------------------------------------------------------------------------- +
* Parms: &DtaQ - The name of the QTEMP Data Queue containing the stack +
* &Function - (P)op - Restore a LIBL from the QTEMP Stack Data Area+
* Remove LIBL from Data Area (Pop the Stack) +
* - (R)estore - a LIBL from the QTEMP Data Area +
* Don't remove, Data Area holds only one LIBL +
* --------------------------------------------------------------------------- +
* M O D I F I C A T I O N L O G +
* --------------------------------------------------------------------------- +
* Date Pgmr Description +
* -------- ---- --------------------------------------------------------- +
* 11Sep20 GAA Created +
* ****************************************************************************/
/* ****************************************************************************+
* Copyright (c) 2020 George Alderton, Walkingstick Software. LLC +
* All rights reserved. +
* +
* Redistribution and use in source and binary forms, with or without +
* modification, are permitted provided that the following conditions +
* are met: +
* 1. Redistributions of source code must retain the above copyright +
* notice, this list of conditions and the following disclaimer. +
* 2. Redistributions in binary form must reproduce the above copyright +
* notice, this list of conditions and the following disclaimer in the +
* documentation and/or other materials provided with the distribution. +
* +
* THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ''AS IS'' AND +
* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +
* ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE +
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +
* LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +
* OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +
* SUCH DAMAGE. +
******************************************************************************/
Pgm (&DtaQ &Function)
Dcl &DtaQ *Char 10
DCL &Function *Char 1 /* (P)op (R)estore */
Dcl &UsrLibl *Char 2750
Dcl &CurLib *Char 10
Dcl &ChgLibl *Char 2783
/* Make sure library list stack exists */
ChkObj QTEMP/&DtaQ *DtaQ
MonMsg CPF9801 Exec(Do)
SndPgmMsg Msg('Data queue QTEMP/' || &DTAQ |< +
' does not exist. POPLIBL not executed.') +
MsgType(*Diag)
SndPgmMsg MsgID(CPF0002) MsgF(QCPFMSG) MsgType(*ESCAPE)
GoTo EndPgm
EndDo
/* Pop data from stack (current library, then library list) */
Call qRcvDtaQ (&DtaQ QTEMP X'00010F' &CurLib X'00000F')
Call qRcvDtaQ (&DtaQ QTEMP X'02750F' &UsrLibl X'00000F')
If (&CurLIb = ' ') Do
SndPgmMsg Msg('Data queue QTEMP/' || &DTAQ |< +
' is Empty. No Matching PSHLIBL executed.') +
MsgType(*Diag)
SndPgmMsg MsgID(CPF0002) MsgF(QCPFMSG) MsgType(*ESCAPE)
Goto EndPgm
EndDo
/* Restore user library list and current library */
If (&UsrLibl = ' ') (ChgVar &USRLIBL *NONE)
ChgVar &ChgLibl ('CHGLIBL LIBL(' || &USRLIBL |< ')' || +
' CURLIB(' || &CURLIB |< ')')
Call qCmdExc (&ChgLibl 2783)
EndPgm:
EndPgm
Code language: PHP (php)
