home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / ibmtsoqueens / ts2ds.pli < prev    next >
Text File  |  2020-01-01  |  36KB  |  441 lines
  1. * PROCESS ;                                                             00000001
  2.  /*****          PL/I - IKJEFF18 INTERFACE         *****/               00000020
  3.  /* FUNCTION:                                          */               00000030
  4.  /*  LINK TO IKJEFF18 TO WRITE A DAIR ERROR MESSAGE    */               00000040
  5.  /* PARAMETERS:                                        */               00000050
  6.  /*  UPT,ECT,ECB,PSCB,DAPB : PARAMETERS FOR IKJDAIR    */               00000060
  7.  /*  RETC : RETURN CODE FROM IKJDAIR                   */               00000070
  8.  /* EXTERNAL REFERENCE:                                */               00000080
  9.  /*  PLILINK : PL/I SVC 6 INTERFACE                    */               00000090
  10.  /* FETCHED DYNAMICALLY:                                                00000100
  11.  /*  IKJEFF18: TSO DAIR ERROR ANALYZER                 */               00000110
  12. 0PLIDAER: PROC(UPT,ECT,ECB,PSCB,DAPB,RETC)                              00000120
  13.          OPTIONS(REENTRANT) RECURSIVE REORDER;                          00000130
  14. 0  DCL UPT,                                                             00000140
  15.        ECT,                                                             00000150
  16.        ECB,                                                             00000160
  17.        PSCB,                                                            00000170
  18.        1 DAPB,                                                          00000180
  19.          2 DACD BIN(15,0),                                              00000190
  20.          2 DAETCETERA,                                                  00000200
  21.        RETC BIN(31,0);                                                  00000210
  22. 0  DCL 1 DAPL,                                                          00000220
  23.          2 DAPLUPT PTR INIT(ADDR(UPT)),                                 00000230
  24.          2 DAPLECT PTR INIT(ADDR(ECT)),                                 00000240
  25.          2 DAPLECB PTR INIT(ADDR(ECB)),                                 00000250
  26.          2 DAPLPSCB PTR INIT(ADDR(PSCB)),                               00000260
  27.          2 DAPLDAPB PTR INIT(ADDR(DAPB));                               00000270
  28.    DCL FF02 BIN(31,0) INIT(0),                                          00000280
  29.        ERRCD BIN(15,0) INIT(1);                                         00000290
  30.    DCL PLILINK ENTRY OPTIONS(ASM INTER RETCODE);                        00000300
  31. 0  CALL PLILINK('IKJEFF18',DAPL,RETC,FF02,ERRCD);                       00000310
  32.  END;                                                                   00000320
  33. /*********************************************************************/ 00000321
  34. * PROCESS ;                                                             00000330
  35.  /***** PL/I - IKJDAIR INTERFACE FOR ALLOCATING EXISTING DATASET *****/ 00000340
  36.  /* FUNCTION:                                                        */ 00000350
  37.  /*  ALLOCATE A EXISTING DATASET                                     */ 00000360
  38.  /* PARAMETERS:                                                      */ 00000370
  39.  /*  UPT : USER PROFILE TABLE                                        */ 00000380
  40.  /*  ECT : ENVIRONMENT CONTROL TABLE                                 */ 00000390
  41.  /*  PSCB : PROTECTED STEP CONTROL BLOCK                             */ 00000400
  42.  /*  DSN : DATASET NAME                                              */ 00000500
  43.  /*  DDN : DDNAME (IF BLANK, RECEIVES THE DDNAME CHOSEN BY IKJDAIR)  */ 00000600
  44.  /*  MNM : MEMBER NAME                                               */ 00000700
  45.  /*  PSWD : PASSWORD                                                 */ 00000800
  46.  /*  DSP123 : STATUS AND DISPOSITIONS                                */ 00000900
  47.  /*  CTL : CONTROL BYTE                                              */ 00001000
  48.  /*  DSO : DATASET ORGANISATION, RECEIVES THE DSORG FOUND BY IKJDAIR */ 00001100
  49.  /*  ALN : ATTRIBUTE LIST NAME                                       */ 00001200
  50.  /*  RETC : RETURN CODE, RECEIVES THE RETURN CODE FROM IKJDAIR       */ 00001300
  51.  /*         THE INITIAL VALUE SELECTS THE ERROR ACTION               */ 00001400
  52.  /* ERROR ACTION :                                                   */ 00001500
  53.  /*  IF IKJDAIR RETCODE = 0 THEN RETURN                              */ 00001600
  54.  /*  ELSE                                                            */ 00001700
  55.  /*    IF RETCODE = -RETC THEN SUPPRESS ERROR MESSAGE, RETURN        */ 00001800
  56.  /*    ELSE                                                          */ 00001900
  57.  /*      IF RETCODE = RETC THEN WRITE ERROR MESSAGE, RETURN          */ 00002000
  58.  /*      ELSE WRITE ERROR MESSAGE, SIGNAL COND(DAIRERR)              */ 00002100
  59.  /* EXTERNAL REFERENCES:                                             */ 00002200
  60.  /*  PLITSSR : PL/I INTERFACE TO TSO SERVICE ROUTINES                */ 00002300
  61.  /*  PLIDAER : IKJDAIR ERROR MESSAGE WRITER                          */ 00002400
  62.  /* FETCHED DYNAMICALLY:                                             */ 00002500
  63.  /*  IKJDAIR : TSO DAIR SERVICE ROUTINE                              */ 00002600
  64. 0PLIDAEX: PROC(UPT,ECT,PSCB,DSN,DDN,MNM,PSWD,DSP123,CTL,DSO,ALN,RETC)   00002700
  65.          OPTIONS(REENTRANT) RECURSIVE REORDER;                          00002800
  66. 0  DCL UPT,                                                             00002900
  67.        ECT,                                                             00003000
  68.        PSCB,                                                            00003100
  69.        DSN CHAR(44) VAR,                                                00003200
  70.        DDN CHAR(8),                                                     00003300
  71.        MNM CHAR(8),                                                     00003400
  72.        PSWD CHAR(8),                                                    00003500
  73.        DSP123 BIT(24) ALIGNED,                                          00003600
  74.        CTL BIT(8) ALIGNED,                                              00003700
  75.        DSO BIT(8) ALIGNED,                                              00003800
  76.        ALN CHAR(8),                                                     00003900
  77.        RETC BIN(31,0);                                                  00004000
  78. 0  DCL PLITSSR ENTRY OPTIONS(ASM INTER RETCODE),                        00004100
  79.        PLIDAER ENTRY;                                                   00004200
  80.    DCL ECB BIN(31,0) INIT(0),                                           00004300
  81.        SPEZRETC BIN(31,0) INIT(RETC);                                   00004400
  82. 1  DCL 1 DA08PB,       /* IKJDAIR PARAMETER BLOCK, CODE 08 */           00004500
  83.          2 DA08CD BIN(15,0) INIT(8),                                    00004600
  84.          2 DA08FLG BIT(16) ALIGNED INIT(0),                             00004700
  85.          2 DA08DARC BIN(15,0) INIT(0),                                  00004800
  86.          2 DA08CTRC BIN(15,0) INIT(0),                                  00004900
  87.          2 DA08PDSN PTR,                                                00005000
  88.          2 DA08DDN CHAR(8),                                             00005100
  89.          2 DA08UNIT CHAR(8) INIT(''),                                   00005200
  90.          2 DA08SER CHAR(8) INIT(''),                                    00005300
  91.          2 DA08BLK BIN(31,0) INIT(0),                                   00005400
  92.          2 DA08PQTY BIN(31,0) INIT(0),                                  00005500
  93.          2 DA08SQTY BIN(31,0) INIT(0),                                  00005600
  94.          2 DA08DQTY BIN(31,0) INIT(0),                                  00005700
  95.          2 DA08MNM CHAR(8),                                             00005800
  96.          2 DA08PSWD CHAR(8),                                            00005900
  97.          2 DA08DSP123 BIT(24) ALIGNED,                                  00006000
  98.          2 DA08CTL BIT(8) ALIGNED,                                      00006100
  99.          2 DA08RES BIT(24) ALIGNED INIT(0),                             00006200
  100.          2 DA08DSO BIT(8) ALIGNED INIT(0),                              00006300
  101.          2 DA08ALN CHAR(8);                                             00006400
  102. 0  IF CTL & '00000100'B THEN       /* DUMMY DATASET */                  00006500
  103.      DO;                                                                00006600
  104.        UNSPEC(DA08PDSN) = 0;       /* IGNORE DSNAME */                  00006700
  105.        DA08DSP123 = '00000100'B;                                        00006800
  106.      END;                                                               00006900
  107.    ELSE                                                                 00007000
  108.      DO;                                                                00007100
  109.        DA08PDSN = ADDR(DSN);                                            00007200
  110.        DA08DSP123 = DSP123 & (3)'00001111'B;                            00007300
  111.      END;                                                               00007400
  112.    DA08DDN = DDN;                                                       00007500
  113.    DA08MNM = MNM;                                                       00007600
  114.    DA08PSWD = PSWD;                                                     00007700
  115.    IF ALN = '' THEN                                                     00007800
  116.      DA08CTL = CTL & '00111100'B;                                       00007900
  117.    ELSE                        /* TURN ON ATTRLIST BIT */               00008000
  118.      DA08CTL = CTL & '00111100'B | '00000010'B;                         00008100
  119.    DA08ALN = ALN;                                                       00008200
  120. 0  CALL PLITSSR('IKJDAIR ',UPT,ECT,ECB,PSCB,DA08PB);                    00008300
  121.    RETC = PLIRETV();                                                    00008400
  122.    IF RETC =0 THEN                                                      00008500
  123.      DO;                                                                00008600
  124.        DDN = DA08DDN;                                                   00008700
  125.        DSO = DA08DSO;                                                   00008800
  126.      END;                                                               00008900
  127. 0  ELSE             /* ANALYZE IKJDAIR ERROR */                         00009000
  128.      IF RETC ^= -SPEZRETC THEN                                          00009100
  129.        DO;                                                              00009200
  130.          CALL PLIDAER(UPT,ECT,ECB,PSCB,DA08PB,RETC);                    00009300
  131.          IF RETC ^= SPEZRETC THEN                                       00009400
  132.            SIGNAL COND(DAIRERR);                                        00009500
  133.        END;                                                             00009600
  134.  END;                                                                   00009700
  135. /*********************************************************************/ 00009800
  136. * PROCESS ;                                                             00009900
  137.  /***** DAIR CODE 00 : SEARCH DSE *****/                                00010000
  138. 0PLIDA00: PROC(UPT,ECT,PSCB,DSN,DDN,CTL,FLG,DSO)                        00010100
  139.            OPTIONS(REENTRANT) RECURSIVE REORDER;                        00010200
  140. 0  DCL DSN CHAR(44) VAR,                                                00010300
  141.        DDN CHAR(8),                                                     00010400
  142.        CTL BIT(8) ALIGNED,                                              00010500
  143.        FLG BIT(16) ALIGNED, /* RECEIVES THE FLAG RETURNED BY IKJDAIR */ 00010600
  144.        DSO BIT(8) ALIGNED; /* RECEIVES THE DSO RETURNED BY IKJDAIR */   00010700
  145. 0  DCL 1 DA00PB,                                                        00010800
  146.          2 DA00CD BIN(15,0),                                            00010900
  147.          2 DA00FLG BIT(16) ALIGNED,                                     00011000
  148.          2 DA00PDSN PTR,                                                00011100
  149.          2 DA00DDN CHAR(8),                                             00011200
  150.          2 DA00CTL BIT(8) ALIGNED,                                      00011300
  151.          2 DA00RES BIN(15,0) UNAL,                                      00011400
  152.          2 DA00DSO BIT(8) ALIGNED;                                      00011500
  153. 0  DCL PLITSSR ENTRY OPTIONS(ASM INTER RETCODE),                        00011600
  154.        PLIDAER ENTRY;                                                   00011700
  155.    DCL ECB BIN(31,0) INIT(0),                                           00011800
  156.        RETCODE BIN(31,0);                                               00011900
  157.    DA00CD = 0;                                                          00012000
  158.    DA00FLG = 0;                                                         00012100
  159.    DA00DDN = DDN;                                                       00012200
  160.    IF DDN = '' THEN                                                     00012300
  161.      DA00PDSN = ADDR(DSN);                                              00012400
  162.    ELSE                                                                 00012500
  163.      UNSPEC(DA00PDSN) = 0;                                              00012600
  164.    DA00CTL = CTL & '00100000'B;                                         00012700
  165.    DA00RES = 0;                                                         00012800
  166.    DA00DSO = 0;                                                         00012900
  167. 0  CALL PLITSSR('IKJDAIR ',UPT,ECT,ECB,PSCB,DA00PB);                    00013000
  168.    RETCODE = PLIRETV();                                                 00013100
  169.    IF RETCODE > 0 THEN                                                  00013200
  170.      DO;                                                                00013300
  171.        CALL PLIDAER(UPT,ECT,ECB,PSCB,DA00PB,RETCODE);                   00013400
  172.        SIGNAL COND(DAIRERR);                                            00013500
  173.      END;                                                               00013600
  174.    ELSE                                                                 00013700
  175.      DO;                                                                00013800
  176.        FLG = DA00FLG;                                                   00013900
  177.        DSO = DA00DSO;                                                   00014000
  178.      END;                                                               00014100
  179.  END;                                                                   00014200
  180. /*********************************************************************/ 00014300
  181. * PROCESS ;                                                             00014400
  182.  /***** SINGLE INFORMATIONAL MESSAGE *****/                             00014500
  183. 0PLIPTIS: PROC(UPT,ECT,INFO) OPTIONS(REENTRANT) RECURSIVE REORDER;      00014600
  184. 0  DCL INFO CHAR(254) VAR;                                              00014700
  185.    DCL 1 INFOLINE,                                                      00014800
  186.          2 ISCT BIN(31,0),                                              00014900
  187.          2 ISPMSG PTR,                                                  00015000
  188.          2 ISLEN BIN(15,0),                                             00015100
  189.          2 ISOFF BIN(15,0),                                             00015200
  190.          2 ISTEXT CHAR(256);                                            00015300
  191.    DCL 1 PUTLPB,                                                        00015400
  192.          2 PTPBCTL BIT(16) ALIGNED,                                     00015500
  193.          2 PTPBTPUT BIN(15,0) INIT(0),                                  00015600
  194.          2 PTPBOPUT PTR,                                                00015700
  195.          2 PTPBFLN PTR INIT(NULL());                                    00015800
  196.    DCL (ECB,RETCODE) BIN(31,0) INIT(0);                                 00015900
  197.    DCL PLITSSR ENTRY OPTIONS(ASM INTER RETCODE),                        00016000
  198.        PLISVC ENTRY(BIN(15,0),BIN(31,0),PTR,BIN(31,0))                  00016100
  199.                OPTIONS(ASM INTER);                                      00016200
  200.    DCL R0 BIN(31,0),                                                    00016300
  201.        R1 PTR;                                                          00016400
  202.    DCL 1 ERRMSG,                                                        00016500
  203.          2 ERRTEXT CHAR(26) INIT('PUTLINE ERROR, RETURN CODE'),         00016600
  204.          2 RETCH  PIC'ZZZZ9';                                           00016700
  205. 0  ISCT = 1;                                                            00016800
  206.    ISPMSG = ADDR(ISLEN);                                                00016900
  207.    ISLEN = LENGTH(INFO)+4;                                              00017000
  208.    ISOFF = 0;                                                           00017100
  209.    ISTEXT = INFO;                                                       00017200
  210.    PTPBCTL = '00010010'B;                                               00017300
  211.    PTPBOPUT = ADDR(INFOLINE);                                           00017400
  212. 0  CALL PLITSSR('IKJPUTL ',UPT,ECT,ECB,PUTLPB);                         00017500
  213.    RETCODE = PLIRETV();                                                 00017600
  214.    IF RETCODE > 4 THEN                                                  00017700
  215.      DO;                                                                00017800
  216.        RETCH = RETCODE;                                                 00017900
  217.        R0 = LENGTH(ERRTEXT)+5;                                          00018000
  218.        R1 = ADDR(ERRMSG);                                               00018100
  219.        CALL PLISVC(93,R0,R1,RETCODE);                                   00018200
  220.        IF RETCODE > 0 THEN                                              00018300
  221.          SIGNAL ERROR;                                                  00018400
  222.      END;                                                               00018500
  223.  END;                                                                   00018600
  224. /*********************************************************************/ 00018700
  225. * PROCESS ;                                                             00018800
  226.  /***********   PL/I - IKJSCAN INTERFACE   ***************/             00018900
  227.  /* FUNCTION:                                            */             00019000
  228.  /*  CALL IKJSCAN SERVICE ROUTINE, ANALYZE ITS OUTPUT.   */             00019100
  229.  /* EXTERNAL REFERENCES:                                 */             00019200
  230.  /*  PLIPTIS : PL/I - PUTLINE INTERFACE (SINGLE INFOMSG) */             00019300
  231.  /*  PLITSSR : PL/I INTERFACE TO TSO SERVICE ROUTINES    */             00019400
  232.  /* FETCHED DYNAMICALLY:                                 */             00019500
  233.  /*  IKJSCAN : TSO IKJSCAN SERVICE ROUTINE               */             00019600
  234. 0PLISCAN: PROC(CBUF,UPT,ECT) RETURNS(CHAR(8))                           00019700
  235.            OPTIONS(REENTRANT) RECURSIVE REORDER;                        00019800
  236. 0  DCL 1 IKJECT BASED(ADDR(ECT)),                                       00019900
  237.          2 UNUSED CHAR(28),                                             00020000
  238.          2 ECTSWS BIT(8) ALIGNED;                                       00020100
  239.    DCL 1 CSPARMS,                                                       00020200
  240.          2 CSECB BIN(31,0) INIT(0),                                     00020300
  241.          2 CSFLG BIT(8) ALIGNED INIT(0),                                00020400
  242.          2 CSRES BIT(24) ALIGNED INIT(0),                               00020500
  243.          2 CSOA,                                                        00020600
  244.            3 CSOACNM PTR,                                               00020700
  245.            3 CSOALNM BIN(15,0),                                         00020800
  246.            3 CSOAFLG BIT(8) ALIGNED,                                    00020900
  247.            3 CSOARES BIT(8) ALIGNED INIT(0);                            00021000
  248.    DCL CMD CHAR(8) BASED(CSOACNM);                                      00021100
  249.    DCL ERRMSG CHAR(34) VAR INIT('IKJSCA01I SCAN PARAMETER ERROR'),      00021200
  250.        NOINFO CHAR(34) VAR INIT('IKJSCA02I NO INFORMATION AVAILABLE'),  00021300
  251.        INVAL CHAR(34) VAR INIT('IKJSCA03I INVALID COMMAND SYNTAX');     00021400
  252.    DCL PLITSSR ENTRY OPTIONS(ASM INTER RETCODE),                        00021500
  253.        PLIPTIS ENTRY;                                                   00021600
  254. 0  CALL PLITSSR('IKJSCAN ',UPT,ECT,CSECB,CSFLG,CSOA,CBUF,               00021700
  255.                 'IKJSCAN DOESNT LIKE VL BIT ON 6. PARAMETER');          00021800
  256.    IF PLIRETV() > 0 THEN                                                00021900
  257.      DO;                                                                00022000
  258.        CALL PLIPTIS(UPT,ECT,ERRMSG);                                    00022100
  259.        SIGNAL ERROR;                                                    00022200
  260.      END;                                                               00022300
  261.    IF CSOALNM > 0 THEN                                                  00022400
  262.      DO;                  /* VALID COMMAND NAME FOUND */                00022500
  263.        IF CSOAFLG = '10000000'B THEN  /* INDICATE PARMS IN ECTSWS */    00022600
  264.          ECTSWS = ECTSWS & '01111111'B;                                 00022700
  265.        ELSE                           /* INDICATE NO PARMS IN ECTSWS */ 00022800
  266.          ECTSWS = ECTSWS | '10000000'B;                                 00022900
  267.        RETURN(SUBSTR(CMD,1,CSOALNM));                                   00023000
  268.      END;                                                               00023100
  269.    SELECT (CSOAFLG);    /* NO VALID CMDNAME FOUND */                    00023200
  270.      WHEN ('00100000'B)                                                 00023300
  271.        CALL PLIPTIS(UPT,ECT,NOINFO);                                    00023400
  272.      WHEN ('00010000'B) ;                                               00023500
  273.      WHEN ('00001000'B)                                                 00023600
  274.        CALL PLIPTIS(UPT,ECT,INVAL);                                     00023700
  275.    END;                                                                 00023800
  276.    RETURN('');                                                          00023900
  277.  END;                                                                   00024000
  278. /*********************************************************************/ 00024100
  279. * PROCESS ;                                                             00024200
  280.  /***** PL/I - IKJSTCK INTERFACES (CREATE/DELETE DS) *****/             00024300
  281.  /* GENERAL PHILOSOPHY:                                  */             00024400
  282.  /*  CONSTRUCT STACK PARAMETER BLOCK,                    */             00024500
  283.  /*  LINK TO IKJSTCK                                     */             00024600
  284.  /*  RETURN IF IKJSTCK RETCODE = 0                       */             00024700
  285.  /*  ELSE WRITE AN ERROR MESSAGE USING PLIPTIS           */             00024800
  286.  /* EXTERNAL REFERENCES:                                 */             00024900
  287.  /*  PLIPTIS : PL/I - PUTLINE INTERFACE (SINGLE INFOMSG) */             00025000
  288.  /*  PLITSSR : PL/I INTERFACE TO TSO SERVICE ROUTINES    */             00025100
  289.  /* FETCHED DYNAMICALLY:                                 */             00025200
  290.  /*  IKJSTCK : TSO STACK SERVICE ROUTINE                 */             00025300
  291. 0/***** CREATE AND STACK A OUTPUT DATASET ELEMENT *****/                00025400
  292. 0PLISTAD: PROC(UPT,ECT,DDN,LIST)                                        00025500
  293.            OPTIONS(REENTRANT) RECURSIVE REORDER;                        00025600
  294. 0  DCL DDN CHAR(8),                                                     00025700
  295.        LIST BIN(15,0);                                                  00025800
  296.    DCL 1 STACKPB,                                                       00025900
  297.          2 STPBOPCD BIT(8) ALIGNED INIT('10000000'B),                   00026000
  298.          2 STPBELCD BIT(8) ALIGNED,                                     00026100
  299.          2 STPBRES BIN(15,0) INIT(0),                                   00026200
  300.          2 STPBALSD BIN(31,0) INIT(0),                                  00026300
  301.          2 STPBIDDP BIN(31,0) INIT(0),                                  00026400
  302.          2 STPBODDP PTR INIT(ADDR(DDN));                                00026500
  303.    DCL ECB BIN(31,0) INIT(0);                                           00026600
  304.    DCL MSG CHAR(34) VAR INIT('IKJSTK01I STACK PARAMETER ERROR');        00026700
  305.    DCL PLITSSR ENTRY(CHAR(8),*,*,*,*) OPTIONS(ASM INTER RETCODE),       00026800
  306.        PLIPTIS ENTRY;                                                   00026900
  307. 0  IF LIST = 1 THEN                                                     00027000
  308.      STPBELCD = '10010001'B;                                            00027100
  309.    ELSE                                                                 00027200
  310.      STPBELCD = '10010000'B;                                            00027300
  311. 0  CALL PLITSSR('IKJSTCK ',UPT,ECT,ECB,STACKPB);                        00027400
  312.    IF PLIRETV() > 0 THEN                                                00027500
  313.      DO;                                                                00027600
  314.        CALL PLIPTIS(UPT,ECT,MSG);                                       00027700
  315.        SIGNAL ERROR;                                                    00027800
  316.      END;                                                               00027900
  317.  END;                                                                   00028000
  318. /*********************************************************************/ 00028100
  319. * PROCESS ;                                                             00028200
  320.  /***** DELETE STACK ELEMENT(S) *****/                                  00028300
  321. 0PLISTD: PROC(UPT,ECT,DELTYPE)                                          00028400
  322.            OPTIONS(REENTRANT) RECURSIVE REORDER;                        00028500
  323. 0  DCL DELTYPE BIT(8) ALIGNED;                                          00028600
  324.    DCL 1 STACKPB,                                                       00028700
  325.          2 STPBOPCD BIT(8) ALIGNED INIT('01000000'B),                   00028800
  326.          2 STPBELCD BIT(8) ALIGNED INIT(0),                             00028900
  327.          2 STPBRES BIN(15,0) INIT(0),                                   00029000
  328.          2 STPBALSD BIN(31,0) INIT(0),                                  00029100
  329.          2 STPBIDDP BIN(31,0) INIT(0),                                  00029200
  330.          2 STPBODDP BIN(31,0) INIT(0);                                  00029300
  331.    DCL ECB BIN(31,0) INIT(0);                                           00029400
  332.    DCL MSG CHAR(34) VAR INIT('IKJSTK01I STACK PARAMETER ERROR');        00029500
  333.    DCL PLITSSR ENTRY(CHAR(8),*,*,*,*) OPTIONS(ASM INTER RETCODE),       00029600
  334.        PLIPTIS ENTRY;                                                   00029700
  335. 0  IF DELTYPE & '00100000'B THEN                                        00029800
  336.      STPBOPCD = '00100000'B;                                            00029900
  337.    ELSE                                                                 00030000
  338.      IF DELTYPE & '00010000'B THEN                                      00030100
  339.        STPBOPCD = '00010000'B;                                          00030200
  340. 0  CALL PLITSSR('IKJSTCK ',UPT,ECT,ECB,STACKPB);                        00030300
  341.    IF PLIRETV() > 0 THEN                                                00030400
  342.      DO;                                                                00030500
  343.        CALL PLIPTIS(UPT,ECT,MSG);                                       00030600
  344.        SIGNAL ERROR;                                                    00030700
  345.      END;                                                               00030800
  346.  END;                                                                   00030900
  347. /*********************************************************************/ 00031000
  348. * PROCESS ;                                                             00031100
  349.  /*************   TSODS COMMAND PROCESSOR FOR TSO   ***************/    00031200
  350.  /* TO BE CALLED AT ENTRY POINT PLICALLA.                         */    00031300
  351.  /* FUNCTION: CREATE A OUTPUT DATASET ELEMENT IN THE TSO STACK    */    00031400
  352.  /*           AND LINK TO THE COMMAND SPECIFIED.                  */    00031500
  353.  /* SYNTAX:  TSODS  'TSO COMMAND'                                 */    00031600
  354.  /* EXTERNAL REFERENCES:                                          */    00031700
  355.  /*  PLISTAD: PL/I IKJSTCK INTERFACE (ADD DATASET ELEMENT)        */    00031800
  356.  /*  PLISTD : PL/I IKJSTCK INTERFACE (DELETE STACK ELEMET(S))     */    00031900
  357.  /*  PLISCAN: PL/I IKJSCAN INTERFACE (SCAN INPUT BUFFER)          */    00032000
  358.  /*  PLILINK: PL/I LINK SVC INTERFACE                             */    00032100
  359.  /*  PLIPTIS: PL/I PUTLINE INTERFACE (WRITE SINGLE MESSAGE)       */    00032200
  360.  /*  PLIDA00: PL/I IKJDAIR INTERFACE (VERIFY FILE ALLOCATED)      */    00032300
  361. 0TSODS: PROC(CBUF,UPT,PSCB,ECT) OPTIONS(MAIN REENTRANT) REORDER;        00032400
  362. 0  DCL PLIXOPT CHAR(30) VAR INIT('ISA(4K),NOSTAE') STATIC EXT;          00032500
  363.    DCL RETCODE BIN(31,0) INIT(0);                                       00032600
  364.    DCL PLISTAD ENTRY(*,*,CHAR(8),BIN(15,0)),                            00032700
  365.        PLISTD  ENTRY(*,*,BIT(8) ALIGNED),                               00032800
  366.        PLISCAN ENTRY RETURNS(CHAR(8)),                                  00032900
  367.        PLILINK ENTRY                                                    00033000
  368.                 OPTIONS(ASM INTER RETCODE),                             00033100
  369.        PLIPTIS ENTRY,                                                   00033200
  370.        PLIDA00 ENTRY;                                                   00033300
  371.    DCL 1 IKJECT BASED(ADDR(ECT)),                                       00033400
  372.          2 UNUSED CHAR(12),                                             00033500
  373.          2 ECTPCMD CHAR(8),                                             00033600
  374.          2 ECTSCMD CHAR(8),                                             00033700
  375.          2 ECTSWS BIT(8) ALIGNED;                                       00033800
  376.    DCL DSN CHAR(44) VAR INIT(''),                                       00033900
  377.        SAVECMD CHAR(8) INIT(ECTPCMD),                                   00034000
  378.        MAINCMD CHAR(8) INIT('TSODS'),                                   00034100
  379.        DELTOP BIT(8) ALIGNED INIT('01000000'B),                         00034200
  380.        CTL BIT(8) ALIGNED INIT(0),                                      00034300
  381.        FLG BIT(16) ALIGNED INIT(0),                                     00034400
  382.        DSO BIT(8) ALIGNED INIT(0);                                      00034500
  383.    DCL NOALC CHAR(78) VAR INIT('IKJTSD01I FILE TSODS NOT ALLOCATED'),   00034600
  384.        NOCMD CHAR(78) VAR INIT('IKJTSD00I COMMAND MISSING'),            00034700
  385.        MSG CHAR(78) VAR;                                                00034800
  386.    DCL CMD CHAR(8);                                                     00034900
  387.    DCL 1 CMDLIST STATIC EXT,  /* LIST OF ALLOWED COMMANDS */            00035000
  388.          2 COUNT BIN(15,0) INIT(23),  /* NUMBER OF COMMANDS IN LIST */  00035100
  389.          2 CMDOKAY(40) CHAR(8) INIT(                                    00035200
  390.            'LDS','LISTD','LISTDS',                                      00035300
  391.            'SP','SPACE',                                                00035400
  392.            'L','LIST',                                                  00035500
  393.            'LA','LISTA','LISTALC',                                      00035600
  394.            'LB','LISTB','LISTBC',                                       00035700
  395.            'ST','STATUS',                                               00035800
  396.            (25)(8)'*');                                                 00035900
  397. 1/***** VARIOUS TESTS *****/                                            00036000
  398. 0  IF ECTSWS & '10000000'B THEN                                         00036100
  399.       DO;               /* NO COMMAND SPECIFIED */                      00036200
  400.          CALL PLIPTIS(UPT,ECT,NOCMD);                                   00036300
  401.          STOP;                                                          00036400
  402.       END;                                                              00036500
  403.    CMD = PLISCAN(CBUF,UPT,ECT);                                         00036600
  404.    IF CMD = '' THEN     /* INVALID COMMAND SYNTAX OR '?' */             00036700
  405.       STOP;                                                             00036800
  406.    SELECT(CMD);            /* SOME COMMANDS NEED SPECIAL TREATMENT */   00036900
  407.       WHEN('TIME')                                                      00037000
  408.          CMD = 'IKJEFT25';                                              00037100
  409.       WHEN('H','HELP');                                                 00037200
  410.       OTHERWISE                                                         00037300
  411.  ALLOWED:                                                               00037400
  412.          DO;                                                            00037500
  413.             LEAVE ALLOWED ;                                             00037600
  414.                                                                         00037700
  415.             DO I=1 TO COUNT;    /* LOOK IN LIST OF ALLOWED COMMANDS */  00037800
  416.                IF CMD = CMDOKAY(I) THEN                                 00037900
  417.                   LEAVE ALLOWED;                                        00038000
  418.             END;                                                        00038100
  419.             MSG = 'IKJTSD04I COMMAND '||CMD||' INVALID UNDER TSODS';    00038200
  420.             CALL PLIPTIS(UPT,ECT,MSG);                                  00038300
  421.             STOP;                                                       00038400
  422.          END;                                                           00038500
  423.    END;                                                                 00038600
  424.    CALL PLIDA00(UPT,ECT,PSCB,DSN,MAINCMD,CTL,FLG,DSO);                  00038700
  425.    IF (FLG & '00000110'B) ^= '00000010'B THEN                           00038800
  426.       DO;     /* FILE TSODS NOT ALLOCATED */                            00038900
  427.          CALL PLIPTIS(UPT,ECT,NOALC);                                   00039000
  428.          ECTPCMD = SAVECMD;                                             00039100
  429.          STOP;                                                          00039200
  430.       END;                                                              00039300
  431. 0/***** STACK OUTPUT DATASET ELEMENT AND LINK TO COMMAND *****/         00039400
  432.          ECTPCMD = CMD;                                                 00039500
  433. 0  CALL PLISTAD(UPT,ECT,MAINCMD,0);                                     00039600
  434.    CALL PLILINK(CMD,CBUF,UPT,PSCB,ECT);                                 00039700
  435.    RETCODE = PLIRETV();                                                 00039800
  436.    ECTPCMD = SAVECMD;                                                   00039900
  437. 0/***** DELETE TOP STACK ELEMENT AND CHECK RETURN CODE FROM LINK *****/ 00040000
  438. 0  CALL PLISTD(UPT,ECT,DELTOP);                                         00040100
  439.    CALL PLIRETC(RETCODE);                                               00040200
  440.  END;                                                                   00040300
  441.