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)

George Alderton

Share