Re: System Entry Point Table...SEPT.

[Gene_Gaunt/ReviewWorks@xxxxxxxxxxxxxxx]

Here's a program that lets you peek into another job's QTEMP.
Call it with one parameter: the target job's 26-character name
(1-10 display; 11-20 user; 21-26 number).  This program temporarily
disconnects from your current job's QTEMP, connects to the target
job's QTEMP, pops up a command line window, and then reconnects
to your current job's QTEMP.


dcl spcptr ?Job     parm;
dcl dd     Job      bas(?Job) pos(1) char(26);
dcl ol     Main     (?Job) ext parm min(1);
dcl sysptr ?Index   auto init("QWCBT_JOB_INDEX", type(ind, H"A4"));
dcl sysptr ?CmdLine auto init("QUSCMDLN", type(pgm));
dcl spcptr ?Mat     auto init(Mat);
dcl dd     Mat      auto char(48) bdry(16);
dcl spcptr ?Wcbte   def(Mat) pos(33);
dcl sysptr ?Target  bas(?Wcbte) pos(33);
dcl spcptr ?TargPco auto;
dcl sysptr ?Qtemp2  bas(?TargPco) pos(65);
dcl sysptr ?Qtemp   baspco pos(65);
dcl sysptr ?Save    auto;
dcl spcptr ?Option  auto init(Option);
dcl dd     Option   auto char(16);
dcl dd     Rule     def(Option) pos(1) bin(2) init(1);
dcl dd     Length   def(Option) pos(3) bin(2) init(32);
dcl dd     Occur    def(Option) pos(7) bin(2) init(1);
dcl dd     Return   def(Option) pos(9) bin(2);

     entry      * (Main) ext;                  -- start here
     cpyblap    Mat, "1", X"00";               -- prepare search argument
     cpybla     Mat(2:26), Job;                -- copy full job name
     fndinxen   ?Mat, ?Index, ?Option, ?Mat;   -- try to find job
     cmpnv(b)   Return, 1 / lo(Bye);           -- jump if not found
     cmpptrt(b) ?Target, X"01" / neq(Bye);     -- jump if not active
     setsppfp   ?TargPco, ?Target;             -- point to target job's PCO
     cpybwp     ?Save, ?Qtemp;                 -- save our QTEMP pointer
     cpybwp     ?Qtemp, ?Qtemp2;               -- swap in target QTEMP
     callx      ?CmdLine, *, *;                -- pop up command line
     cpybwp     ?Qtemp, ?Save;                 -- restore our QTEMP pointer
Bye: pend;                                     -- return to caller


+---
| This is the MI Programmers Mailing List!
| To submit a new message, send your mail to MI400@midrange.com.
| To subscribe to this list send email to MI400-SUB@midrange.com.
| To unsubscribe from this list send email to MI400-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: dr2@cssas400.com
+---