BETA TITLE 'TSO EDIT COMMAND TABSET SUBCOMMAND IKJEBETA' 00300020 IKJEBETA CSECT 00600020 *********************************************************************** 00900020 * * 01200020 *STATUS -- VERSION NO. 01, OS/360 RELEASE NO. 20 * 01500020 * * 01800020 *FUNCTION -- THIS EDIT SUBCOMMAND CONTROL TABULATION TABLE SETTINGS. * 02100020 * IT WILL TURN A TAB SWITCH ON OR OFF, ALLOW DEFAULT TAB SETTINGS * 02400020 * TO BE USED, ACCEPT A STRING OF NEW TAB SETTINGS (UP TO TEN) * 02700020 * OR ACCEPT A STRING OF 'T'S WHICH ARE TRANSLATED INTO TAB STOPS. * 03000020 * * 03300020 *ENTRY POINT -- IKJEBETA * 03600020 * * 03900020 *INPUT -- REGISTER 1 CONTAINS A POINTER TO THE EDIT COMMUNICATION * 04200020 * AREA, DEFINED IN THE IKJEBECA MACRO. * 04500020 * * 04800020 *OUTPUT -- RETURN CODE IN REGISTER 15 -- * 05100020 * 00 - NORMAL COMPLETION * 05150020 * 08 - FLUSH STACK, PROCESSING INCOMPLETE * 05200020 * * 05400020 *EXTERNAL REFERENCES * 05700020 * IKJPARS - CHECKS SYNTAX OF SUBCOMMAND * 06000020 * IKJGETL - GETS INPUT FROM TERMINAL * 06300020 * * 06900020 * MACROS USED -- * 07200020 * IKJEBESV - ENTRY LINKAGE * 07500020 * IKJEBERT - EXIT LINKAGE * 07800020 * IKJEBEML - MESSAGE SELECTION INTERFACE * 08100020 * IKJEBEMI - EQU'S FOR MESSAGE SELECTION * 08400020 * IKJRLSA - RELEASE PARSE PDL CORE * 08420020 * GETLINE - SETS UP PARMS AND LINKS TO IKJGETL * 08440020 * FREEMAIN - FOR GETLINE CODE, FREES CORE FROM LINE * 08460020 * IKJPARM - BEGINS PARSE PCL * 08480020 * IKJKEYWD - DEFINES KEYWORDS TO PARSE PCL * 08500020 * IKJNAME - DEFINES KEYWORD NAMES TO PARSE PCL * 08520020 * IKJSUBF - DEFINES PARSE SUBFLDS FOR PCL * 08540020 * IKJIDENT - DEFINES INTEGER STRING FOR PARSE PCL * 08560020 * IKJEBEMG - DEFINES MESSAGE INSERTIONS * 08580020 * IKJENDP - END OF PARSE PCL * 08600020 * * 08700020 *EXITS, NORMAL -- RETURN TO CALLER WITH RETURN CODE ZERO IN REG 15 * 09000020 * * 09300020 *EXITS, ERROR -- NONE. * 09600020 * * 09900020 *TABLES/WORK AREAS -- THE CASCWKA FIELD OF THE EDIT COMMUNICATION * 10200020 * AREA IS USED FOR WORK AREAS. THE CATABS FIELD OF THE EDIT * 10400020 * COMMUNICATION AREA IS UPDATED WITH NEW TABULATION PARAMETERS. * 10600020 * * 10800020 *ATTRIBUTES -- REFRESHABLE, ENABLED, NON-PRIVILEGED. * 11100020 * * 11200020 *NOTES -- THERE IS NO CHARACTER CODE DEPENDENCY. * 11300020 *********************************************************************** 11400020 EJECT 11500020 * REGISTER AND SPECIAL EQUATES 11600020 SPACE 11700020 PARMREG0 EQU 0 PARAMETER REG 13200020 PARMREG1 EQU 1 PARAMETER REG 13500020 WORKREGA EQU 2 GENERAL 13800020 WORKREGB EQU 3 USAGE 14100020 WORKREGC EQU 4 WORK 14400020 WORKREGD EQU 5 REGISTERS 14700020 WORKREGE EQU 6 FOR 15000020 WORKREGF EQU 7 PROGRAM 15300020 COMMREG EQU 9 BASE REG FOR COMM AREA DSECT 15600020 BASEREG EQU 11 BASEREG FOR PROG CSECT 15900020 DATAREG EQU 12 REGISTER 16200020 SAVEREG EQU 13 ADDR OF SAVE AREA REG 16500020 RETREG EQU 14 RETURN ADDRESS REG 16800020 RETCDREG EQU 15 RETURN CODE REG 17100020 CHART EQU C'T' CHARACTER T FOR IMAGE SEARCH 17400020 SCHART EQU C't' SMALL CHAR T FOR IMAGE SEARCH 17700020 TABREG EQU 8 OFFSET REG FOR TAB TABLE 18000020 PARSREG EQU 10 BASE REG FOR PDL DSECT 18300020 TABOFFOP EQU X'00' IMMED OP TO TURN OFF TABSWITCH 18600020 TABONOP EQU X'FF' IMMED OP TO TURN ON TABSWITCH 18900020 L255 EQU 255 MAX LENGTH 19200020 INSOP EQU X'F0' OP TO SET UP DIGIT FOR PRINT 19500020 ZERO EQU C'0' CHARACTER ZERO 19700020 L5 EQU 5 FIVE LENGTH 19900020 TABTESTO EQU X'80' INDICATOR FOR INTEGER LIST 20100020 RET16 EQU 16 RETURN CODE FOR I/O ERROR 20400020 SEQ2 EQU 2 SEQUENCE NUMBER 2 20700020 SEQ3 EQU 3 SEQUENCE NUMBER 3 21000020 L1 EQU 1 LENGTH 21300020 L6 EQU 6 LENGTH 21600020 L4 EQU 4 LENGTH 21900020 L0 EQU 0 LENGTH 22200020 L8 EQU 8 LENGTH 22500020 L11 EQU 11 LENGTH 22800020 L3 EQU 3 LENGTH 23100020 L2 EQU 2 LENGTH 23400020 RET8 EQU 8 RET CODE FOR STACK FLUSH 23450020 IKJEBEMI (0,312,313,556,557,562) 23700020 EJECT 23760020 * ENTRY LINKAGE 23820020 IKJEBESV (14,12),,* 23880020 USING IKJEBECA,COMMREG 23940020 SPACE 24000020 B LROUT PERFORM INTERNAL RTN TO GET LINELNT 24300020 SPACE 24500020 * IF NO OPERANDS ARE PRESENT, TURN ON TAB SWITCH AND EXIT 24700020 LL TM CAPTIBFR,CAOPERND ANY OPERANDS 24900020 BNZ PARSIT IF SO, BRANCH 25200020 OI CATABS,TABONOP TURN ON TABSWITCH 25500020 B OUT AND EXIT 25800020 EJECT 25900020 SPACE 26100020 * SET UP AND LINK TO IKJPARS TO SYNTAX CHECK COMMAND 26400020 PARSIT LA PARMREG1,CATMPLST ADDR OF TMP PARM LIST 26700020 USING PPL,PARMREG1 ADDRABILITY FOR PARSE PARMLIST 27000020 L WORKREGA,PRSAD ADDR OF PARSE PCL 27300020 ST WORKREGA,PPLPCL STORE IN PARMLIST 27600020 LA WORKREGA,CAPTPRSD ADDR TO PUT PDL PTR IN 27900020 ST WORKREGA,PPLANS STORE IN PARMLIST 28200020 L WORKREGA,CAPTIBFR ADDR OF SUBCOMMAND BFR 28500020 ST WORKREGA,PPLCBUF STORE IN PARMLIST 28800020 ST SAVEREG,PPLUWA ADDR OF CURRENT SAVEAREA 29100020 DROP PARMREG1 DROP DSECT ADDRABILITY 29400020 LINK EP=IKJPARS 29700020 B RETCHKPA(RETCDREG) HANDLE ROUTING UPON PARSE RETURN 29900020 * 30100020 * CHECK RETURN CODE FROM PARSE 30300020 RETCHKPA EQU * 30500020 B OFSPEC RC 0, CONTINUE PROCESSING 30700020 B OUT8 RC 4, RETURN TO CALLER 30900020 B OUT RC 8, RETURN TO CALLER 31100020 B CMDERRPA RC 12,SYSTEM COMMAND ERROR MESSAGE 31300020 B NOSPAC RC 16, NO CORE MESSAGE 31500020 EJECT 31600020 SPACE 31800020 * EXAMINE PARSE PDL 32100020 OFSPEC L PARSREG,CAPTPRSD ADDR OF PDL 32400020 USING IKJPARMD,PARSREG 32700020 LA WORKREGA,SEQ2 SEQ NUM OF 'OFF' PDL ENTRY 33000020 CH WORKREGA,POPNDS IS 'OFF' SPECIFIED 33300020 BNE IMSPEC IF NOT, BRANCH 33600020 LA PARSREG,CAPTPRSD PTR TO PDL 33900020 IKJRLSA (PARSREG) 34200020 OI CAPRSPDL,CAFREEDL INDICATE PDL FREED 34250020 NI CATABS,TABOFFOP TURN OFF TAB SWITCH 34500020 B OUT AND EXIT 34800020 IMSPEC OI CATABS,TABONOP TURN ON TAB SWITCH 35100020 LA WORKREGA,SEQ3 SEQ NUM OF 'IMAGE' PDL ENTRY 35400020 CH WORKREGA,POPNDS IS 'IMAGE' SPECIFIED 35700020 BE PROCIM IF SO, BRANCH 36000020 EJECT 36100020 SPACE 36300020 * PROCESS INTEGER LIST, IF ANY 36600020 LA TABREG,CATABS+L1 ADDR OF BODY OF TAB TABLE 36900020 L WORKREGA,NUM1 ADDR OF FIRST TAB 37200020 TM NUM1+L6,TABTESTO TEST FIRST INTEGER FLAG 37500020 BZ OUT IF NO TABS, EXIT 37800020 LA WORKREGE,NUM1 BEGINNING OF PDL ENTRIES 38100020 LH WORKREGB,L4(WORKREGE) FOR INTEGERS 38400020 BAL WORKREGF,CONVER LINK TO CONVERT INTEGER 38700020 LTR WORKREGB,WORKREGB TEST INTEGER 39000020 BZ LXA IF ZERO IGNORE DIGIT 39300020 C WORKREGB,LINELNTH 39600020 BH ERRLNTH IF TOO LONG GO TO ERROR MSG 39900020 STC WORKREGB,L0(TABREG) STORE TAB INTO TABLE 40200020 LA TABREG,L1(TABREG) INCREMENT POINTER 40500020 LX LA WORKREGE,L8(WORKREGE) INCREMENT PDL POINTER 40800020 L WORKREGA,L0(WORKREGE) IF NO MORE TABS 41100020 C WORKREGA,FOXO IS THIS LAST IKJIDENT PDE 41400020 BE PLUG IF NO MORE TABS PLUG TABLE AND EXIT 41700020 LR WORKREGE,WORKREGA SAVE INTEGER 42000020 LA WORKREGA,CATABS+L11 IF TAB TABLE FULL 42300020 CR TABREG,WORKREGA BRANCH TO EXIT ROUTINE 42600020 BE TOOMTABS IF FULL, ERROR MSG THEN EXIT 42900020 L WORKREGA,L0(WORKREGE) PTR TO INTEGER 43200020 LH WORKREGB,L4(WORKREGE) LENGTH OF INTEGER 43500020 BAL WORKREGF,CONVER LINK TO CVB ROUTINE 43800020 LTR WORKREGB,WORKREGB TEST INTEGER 44100020 BZ LXA IF ZERO, IGNORE 44400020 C WORKREGB,LINELNTH IS TAB GT LINE LENGTH 44700020 BH ERRLNTH IF SO, BRANCH 45000020 LR WORKREGA,TABREG PTR TO NEW TAB ENTRY 45300020 STC WORKREGB,L0(TABREG) STORE IN TAB TABLE 45600020 LA WORKREGD,CATABS ADDR OF TAB SWITCH 45900020 INSLOOP BCTR WORKREGA,PARMREG0 DECREMENT POINTER 46200020 CR WORKREGA,WORKREGD PTR AT BOTTOM OF TABLE 46500020 BE INSERT IF SO, BRANCH 46800020 CLC L0(L1,WORKREGA),L0(TABREG) COMPARE NEW TAB 47100020 BE LX IF EQUAL, BRANCH TO GET NEXT 47400020 BH INSLOOP LOOP TILL FIND TABLE POSIT 47700020 INSERT LR WORKREGD,TABREG SAVE PTR TO NEXT AVAIL TAB 48000020 LOOPIN BCTR WORKREGD,PARMREG0 DECREMENT COUNT 48300020 CR WORKREGD,WORKREGA IS SEARCH AT BOTTOM OF TABLE 48600020 BE INSERTA INSERT AT BOTTOM OF TABLE 48900020 MVC L1(L1,WORKREGD),L0(WORKREGD) 49200020 B LOOPIN LOOP TILL INSERT PT FOUND 49500020 SPACE 49600020 * INSERTION POINT HAS BEEN FOUND 49700020 INSERTA STC WORKREGB,L1(WORKREGA) INSERT TAB IN TABLE 49800020 LA TABREG,L1(TABREG) 50100020 B LX REPEAT FOR ALL TABS 50400020 CONVER LA WORKREGD,CONAREA+L3 ADDR OF END OF RECEIVING FIELD 50700020 LA WORKREGC,L0(WORKREGA,WORKREGB) 51000020 BCTR WORKREGC,PARMREG0 ADDR OF LAST DIGIT 51300020 MVC CONAREA(L4),CONZERS ZERO AREA 51600020 CONLOOP MVC L0(L1,WORKREGD),L0(WORKREGC) MOVE LAST DIGIT 51900020 BCTR WORKREGD,PARMREG0 DECREMENT POINTERS 52200020 BCTR WORKREGC,PARMREG0 AND MOVE RIGHT TO LEFT 52500020 BCT WORKREGB,CONLOOP DIGITS INTO AREA 52800020 PACK CONAREA,CONAREA PACK THE DIGITS 53100020 SR WORKREGD,WORKREGD LEADING 53400020 ST WORKREGD,CONAR ZEROES IN DOUBLE WORD 53700020 CVB WORKREGB,CONAR CONVERT TO BINARY 54000020 BR WORKREGF AND RETURN 54300020 LXA EQU * PUT MSG IGNORING ZERO 54600020 IKJEBEML M562,0,0,0,MF=(E,AREAM) 54900020 B LX AND RETURN TO IGNORE ZERO 55200020 NOSPAC EQU * 55500020 IKJEBEML M312,0,NONINS,0,MF=(E,AREAM) 55800020 B OUT8 EXIT 56100020 EJECT 56200020 SPACE 56400020 * RTN TO DET LINE LENGTH 56700020 LROUT EQU * 57000020 LH WORKREGA,CALRECL LOAD LRECL 57300020 LA WORKREGB,L4 LENGTH OF LL00 57600020 SR WORKREGA,WORKREGB SUBTRACT 57900020 TM CACFLAG1,CANONUM IS DS NUMBERED 58200020 BNZ NONUM IF NOT, BRANCH 58500020 SR WORKREGB,WORKREGB SUBT NUMBER LENGTH 58800020 IC WORKREGB,CALENGTH SUBT LENGTH OF LINE NUMBER 59100020 SR WORKREGA,WORKREGB FROM LRECL REMAINDER 59400020 NONUM ST WORKREGA,LINELNTH STORE IN WORK AREA 59700020 B LL GO TO BEGINNING OF PROG 60000020 EJECT 60100020 SPACE 60300020 SPACE 60900020 * ROUTINE TO GET LINE OF T'S AND DETERMINE TABS 61200020 PROCIM MVC GETAREA(GETLEN-GETLIST),GETLIST MOVE PARAMS 61500020 GETLINE PARM=GETAREA,MF=(E,CATMPLST) 61800020 B RETCHKGL(RETCDREG) HANDLE ROUTING UPON GETLINE RETURN 61870020 * 61940020 * CHECK RETURN CODE FROM GETLINE 62010020 RETCHKGL EQU * 62080020 B PROCIMA RC 0, CONTINUE PROCESSING 62150020 B PROCIMB RC 4, INPUT LINE NOT FROM TERMINAL 62220020 B OUT RC 8, ATTENTION ISSUED 62290020 B CMDERRGL RC 12, COMMAND SYSTEM ERROR 62360020 B PROCIM RC 16, NO INPUT RETURNED 62430020 B CMDERRGL RC 20, COMMAND SYSTEM ERROR 62500020 B NOSPAC RC 24, NO SPACE AVAILABLE 62570020 PROCIMA EQU * 62620020 NI CACFLAG4,X'FF'-CAINPROC TURN OFF PROCEDURE BIT 62670020 B PROCIMM CONTINUE PROCESSING 62680020 PROCIMB OI CACFLAG4,CAINPROC TURN ON PROCEDURE BIT 62690020 PROCIMM L WORKREGA,GETAREA+L4 ADDR OF INPUT BUFFER 62700020 LH WORKREGB,L0(WORKREGA) LENGTH OF BUFFER 63000020 ST WORKREGB,BUFREELN 63300020 ST WORKREGA,BUFREEAR 63600020 LA TABREG,CATABS+L1 ADDR OF TABLE 63900020 LR WORKREGD,WORKREGA 64200020 LA WORKREGD,L3(WORKREGD) OFFSET CHECKER 64500020 LA WORKREGA,L4(WORKREGA) POINT TO DATA PORTION 64800020 LA WORKREGC,L4 LENGTH ADJUSTMENT 65100020 SR WORKREGB,WORKREGC CORRECT LENGTH OF DATA PORTION 65400020 LTR WORKREGB,WORKREGB WAS CR ENTERED 65450020 BZ FREET IF SO, NO TABS IN EFFECT 65500020 IMLOOP CLI L0(WORKREGA),CHART IS CHARACTER 'T' 65700020 BE IMINS IF SO, BRANCH 66000020 CLI L0(WORKREGA),SCHART COMPARE FOR SMALL CHAR 'T' 66300020 BE IMINS IF EQUAL BRANCH TO INSERT 66600020 CONTA EQU * 66700020 LA WORKREGA,L1(WORKREGA) INCREMENT POINTER 66900020 BCT WORKREGB,IMLOOP LOOP UNTIL INPUT EXHAUSTED 67200020 FREET EQU * 67250020 FREEMAIN V,A=BUFREEAR,SP=1,MF=(E,FREEXX) 67500020 EJECT 67600020 * END OF TABLE PROCESS 67700020 PLUG EQU * 67750020 SR WORKREGA,WORKREGA ZERO FLUSH INDICATOR 67760020 PLUG8 EQU * 67770020 MVI L0(TABREG),TABOFFOP PLUG END OF TAB TABLE 67800020 LA PARSREG,CAPTPRSD PTR TO PDL 68100020 IKJRLSA (PARSREG) 68400020 OI CAPRSPDL,CAFREEDL INDICATE PDL FREED 68450020 LTR WORKREGA,WORKREGA TEST FOR FLUSH IND 68500020 BNZ OUT8 IF INDICATED, BRANCH 68550020 B OUT EXIT 68700020 IMINS LR WORKREGC,WORKREGA PTR TO 'T' 69000020 SR WORKREGC,WORKREGD GET OFFSET 69300020 C WORKREGC,LINELNTH IS IT GT LINE LENGTH 69600020 BH ERRLNTH1 IF SO, BRANCH 69900020 LA WORKREGE,CATABS+L11 ADDR OF END OF TAB TABLE 70200020 CR TABREG,WORKREGE IS TAB TABLE FULL 70500020 BNL TOOMTABS IF SO, BRANCH 70800020 STC WORKREGC,L0(TABREG) STORE TAB INTO TABLE 71100020 LA TABREG,L1(TABREG) INCREMENT POINTER 71400020 B CONTA LOOP TO FIND ALL TS 72000020 EJECT 72300020 SPACE 72600020 * ERROR MESSAGE ROUTINES 72900020 CMDERRPA MVC COMMAND,PARSE PUT PARSE INSERT IN MACRO EXPANSION 72920020 B CMDERR BRANCH TO COMPLETE DYNAMIC MACRO 72940020 CMDERRGL MVC COMMAND,GETLINE PUT GETLINE INSERT IN MACRO 72960020 CMDERR EQU * 72980020 MVC CSERINSA,CSERINS1 INITIALIZE DYNAMIC IKJEBEMG 73000020 MVC CSERINSB,CSERINS2 INITIALIZE DYNAMIC IKJEBEMG 73020020 LA WORKREGA,CSERINSB MAKE FIRST DYNAMIC INSERT MACRO 73040020 ST WORKREGA,CSERINSA POINT TO THE SECOND 73060020 CVD RETCDREG,CSERAREA CONVERT PARSE RETURN CODE 73080020 UNPK CSERINS,CSERAREA TO ZONED DECIMAL 73100020 OI CSERINZ,INSOP 73120020 IKJEBEML M313,M3131,0,CSERINSA,MF=(E,AREAM) 73140020 * PRODUCE ERROR MESSAGE 73160020 B OUT8 RETURN TO CALLER 73180020 TOOMTABS EQU * 73200020 IKJEBEML M557,0,0,0,MF=(E,AREAM) 73500020 B PLUG BRANCH TO PLUG AND EXIT 73800020 * MESSAGE ROUTINE FOR TAB TOO LARGE FOR LINE 73900020 ERRLNTH1 EQU * 74100020 LR WORKREGB,WORKREGC 74400020 ERRLNTH EQU * 74700020 MVC TOOMGA(TOOMGLN-TOOMG),TOOMG 75000020 MVC TOMGA(TOMGLN-TOMG),TOMG 75300020 CVD WORKREGB,CONAR CONVERT TAB TO DECIMAL 75600020 UNPK CONAR(L4),CONAREA(L4) UNPACK NUMBER 75900020 OI CONAR+L3,INSOP ZONE ON LAST DIGIT TO X'F' 76200020 LA WORKREGD,TOOMGA+L8 POINT TO TEXT AREA FOR INSERTION 76500020 LA WORKREGB,L3 LENGTH OF DIGIT STRING MINUS ONE 76800020 LA WORKREGA,CONAR NUMBER WITHOUT ZERO SUPPRESS 77100020 DELZER CLI L0(WORKREGA),ZERO IS DIGIT A ZERO 77400020 BNE ZERDEL GET OUT OF LOOP WITH FIRST NONZERO 77700020 LA WORKREGA,L1(WORKREGA) INCREMENT POINTER 78000020 BCTR WORKREGB,PARMREG0 DECREMENT COUNT OF SIG DIGITS 78300020 B DELZER LOOP UNTIL FIRST NONZERO FOUND 78600020 ZERDEL LA WORKREGC,L5(WORKREGB) TOT LENGTH OF INSERT 78900020 STH WORKREGC,TOOMGA+L4 79200020 EX WORKREGB,MOVINS MOVE INSERT INTO INSERTION PARMLIST 79500020 L WORKREGC,LINELNTH LINE LENGTH 79800020 CVD WORKREGC,CONAR CONVERT TO DECIMAL 80100020 UNPK CONAR(L4),CONAREA(L4) UNPACK 80400020 OI CONAR+L3,INSOP ZONE LAST DIGIT TO X'F' 80700020 LA WORKREGD,TOMGA+L8 POINT TO INSERTION AREA 81000020 LA WORKREGB,L3 81300020 LA WORKREGA,CONAR NONZERO SUPPRESSED NUMBER 81600020 DELZER1 CLI L0(WORKREGA),ZERO IS DIGIT A ZERO 81900020 BNE ZERDEL1 IF NOT, EXIT LOOP 82200020 LA WORKREGA,L1(WORKREGA) INCREMENT POINTER 82500020 BCTR WORKREGB,PARMREG0 DECREMENT SIGNIFICANT DIGIT COUNT 82800020 B DELZER1 LOOP UNTIL FIRST NONZERO FOUND 83100020 ZERDEL1 LA WORKREGC,L5(WORKREGB) LENGTH OF INSERT 83400020 EX WORKREGB,MOVINS MOVE INSERTION INTO PARM BLOCK 83700020 STH WORKREGC,TOMGA+L4 STORE LENGTH INTO PARM BLOCK 84000020 LA WORKREGA,TOMGA ADDR OF SECOND INSERTION 84300020 ST WORKREGA,TOOMGA CHAIN INSERTION BLOCKS 84600020 LBLB IKJEBEML M556,0,TOOMGA,0,MF=(E,AREAM) 84900020 SR RETCDREG,RETCDREG 85200020 LA WORKREGA,RET8 IND FLUSH STACK 85250020 B PLUG8 GO TO PLUG AND EXIT 85500020 EJECT 85600020 * EXIT FROM PROGRAM 85700020 OUT8 EQU * 85750020 LA RETCDREG,RET8 INDICATE FLUSH STACK 85760020 B OUTA EXIT 85770020 OUT EQU * 85800020 SR RETCDREG,RETCDREG 86100020 OUTA EQU * 86150020 IKJEBERT (14,12),,RC=(15) 86400020 EJECT 86500020 SPACE 86700020 * IKJPARS PCL 87000020 IKJEBTA0 IKJPARM 87300020 POPNDS IKJKEYWD DEFAULT='ON' 87600020 IKJNAME 'ON',SUBFLD=PINT 87900020 IKJNAME 'OFF' 88200020 IKJNAME 'IMAGE' 88500020 PINT IKJSUBF 88800020 NUM1 IKJIDENT 'INTEGER',LIST,MAXLNTH=3,FIRST=NUMERIC,OTHER=NUMERIC,X89000020 HELP=('NUMBER 3 OR LESS DIGITS IN LENGTH') 89200020 IKJENDP 89400020 EJECT 89500020 * CONSTANTS AND MESSAGE CONSTANTS 89600020 PRSAD DC V(IKJEBTA0) ADCON FOR PARSE PCL 89700020 CONZERS DC X'F0F0F0F0' CHAR ZEROES FOR CONVER SUBRTN 90000020 GETLIST GETLINE INPUT=(ISTACK),MF=L 90300020 GETLEN EQU * 90600020 CSERINS1 IKJEBEMG 0,M3131IN1,' ' 90640020 CSERINSX EQU * 90680020 CSERINS2 IKJEBEMG 0,M3131IN2,'00' 90720020 CSERINSY EQU * 90760020 PARSE DC CL5'PARSE' INSERT FOR CMD SYS ERR MSG 90800020 GETLINE DC CL7'GETLINE' INSERT FOR CMD SYS ERR MSG 90840020 NONINS IKJEBEMG ,M312IN1,'TABSET' 90900020 TOOMG IKJEBEMG ,M556IN1,' ' 91200020 TOOMGLN EQU * 91500020 TOMG IKJEBEMG ,M556IN2,' ' 91800020 TOMGLN EQU * 92100020 MOVINS MVC L0(L0,WORKREGD),L0(WORKREGA) MOVE FOR MSGS INSERTS 92400020 DS 0F 92700020 FOXO DC X'FF000000' END OF LIST INDICATOR FOR TAB PDE'S 93000020 EJECT 93100020 IKJEBECA 93300020 EJECT 93400020 * WORK AREAS 93500020 ORG CASCWKA SUBCOMMAND WORKAREA 93600020 GETAREA DS CL(GETLEN-GETLIST) GETMAIN LFORM SPACE 93900020 TOOMGA DS CL(TOOMGLN-TOOMG) MSG INSERT LFORM SPACE 94200020 TOMGA DS CL(TOMGLN-TOMG) MSG INSERT LFORM SPACE 94500020 LINELNTH DS 1F LENGTH OF LINE 94800020 DS 0D 95100020 CONAR DS 1F CONVERSION WORKAREA 95400020 CONAREA DS 1F CONVERSION WORKAREA 95700020 AREAM DS 10F MSG SELECT WORKAREA 96000020 DS 0D 96600020 BUFREEAR DS 1F ADDR OF GETL BUFF TO FREE 96900020 BUFREELN DS 1F LENGTH OF GETLINE BUFFER TO FREE 97200020 FREEXX DS 3F FREEMAIN WORKAREA 97300020 CSERAREA DS D DECIMAL CONVERSION WORK AREA 97530020 CSERINSA DS CL(CSERINSX-CSERINS1-L4) MSG INSERT AREA 97560020 * DYNAMIC CSE INSERTION MACRO, FIRST 97590020 COMMAND DS CL8 SYSTEM ERROR COMMAND NAME 97620020 CSERINSB DS CL(CSERINSY-CSERINS2-L2) MSG INSERT WORKAREA 97650020 * DYNAMIC CSE INSERTION MACRO, SECOND 97680020 CSERINS DS 0CL2 PARSE RETURN CODE INSERT 97710020 DS CL1 RETCODE INSERT 97740020 CSERINZ DS CL1 SIGN INDICATOR ZONE 97770020 ORG , RESTORE LOCATION COUNTER 97870020 EJECT 97970020 IKJPPL 98100020 END 98400020