MACRO 00001000 &NAME FORWARD &DEST=,&EOA=,&EXIT=,&THRESH=,&TASK= @YM04688 00002000 .*A-000000-999999 @Z37X9M0 00003000 .*A903000,910000 SA56312 00004000 .*C126000 SA57691 00005000 .*A112000,A133000 @YA11171 00006000 .*A014000,056000,059000,102000,102100 @Y17XAMN 00007000 .*C014000,059000,099300 @Y17XAMN 00008000 .*D060000-061000,063000,066000 @Y17XAMN 00009000 .*C003180 @OX19417 00009182 .* DUMMY APAR @OZ27328 00009282 .* A003440 @OZ48773 00009382 GBLA &IEDQZD,&IEDQZE(64),&IEDQZK 00030000 GBLB &IEDQZA(64) 00031000 GBLC &IEDQZB 00032000 LCLA &BIT,&LEN,&STATUS,&AA,&CT,&D @YM06054 00032500 LCLA &E,&G . S22027 00034000 LCLB &FLG,&HEX,&TH S22025 00035000 LCLC &C,&A S22025 00036000 .* &QCBNM IS ADDED AS A LCLC VARIABLE FOR TASK = 'TOTE' @Y17XAMN 00038000 .* OR 'SSCP' @Y17XAMN 00039000 LCLC ®,&QCBNM . @Y17XAMN 00041000 SPACE 00043000 &LEN SETA 12 00044000 AIF (&IEDQZA(3)).TSOCHK 00045000 MNOTE 12,'*** IHB070 SEQUENCE ERROR-MUST FOLLOW INHDR MACRO' 00046000 AGO .MEND 00047000 .TSOCHK ANOP TSO 00048000 AIF (NOT &IEDQZA(9)).TRYTSK @Y17XAMN 00049000 MNOTE 12,'*** IHB312 MUST FOLLOW STARTMH MACRO WITH TSOMH=NO*00050000 ' 00051000 AGO .MEND TSO 00052000 .* IS THE TASK OPERAND CODED? IF NO, CONTINUE WITH FORWARD @Y17XAMN 00054000 .* LOGIC AT .TRYTHR @Y17XAMN 00055000 .TRYTSK ANOP @Y17XAMN 00057000 AIF ('&TASK' EQ '').TRYTHR @Y17XAMN 00058000 .* IS ANY OTHER OPERAND CODED? IF NOT, CONTINUE WITH TASK @Y17XAMN 00060000 .* OPERAND FIELD INTERROGATION. @Y17XAMN 00061000 AIF ('&THRESH' NE '' OR '&DEST' NE '' OR '&EOA' NE '').ERR2 00063000 AIF ('&EXIT' EQ '').TSKCHK @YM04688 00064000 .ERR2 MNOTE 4,'*** IED700 UNNECESSARY OPERANDS ARE CODED , WILL BE IG00066000 GNORED' @Y17XAMN 00067000 .* IS TASK = SSCP? IF NO, CHECK FOR TASK TOTE. @Y17XAMN 00069000 .TSKCHK ANOP @Y17XAMN 00071000 &QCBNM SETC 'SSCP' @Y17XAMN 00072000 &IEDQZD SETA 4 @Y17XAMN 00073000 AIF ('&TASK' NE 'SSCP').TK1 @Y17XAMN 00074000 AIF (&IEDQZA(30)).TSKSSC @Y17XAMN 00078000 MNOTE 12,'*** IED701 INVALID USE OF TASK OPERAND, NO SSCP MH.' 00079000 AGO .MEND @Y17XAMN 00080000 .* IS TASK = TOTE? IF NO, CHECK FOR TASK = REG(NUMBER). @Y17XAMN 00082000 .TK1 ANOP @Y17XAMN 00084000 &QCBNM SETC 'TOTE' @Y17XAMN 00085000 &IEDQZD SETA 4 @Y17XAMN 00086000 AIF ('&TASK' NE 'TOTE').TK2 @Y17XAMN 00087000 AIF (&IEDQZA(30) OR &IEDQZA(32)).TSKSSC @Y17XAMN 00091000 MNOTE 12,'*** IED703 INVALID USE OF TASK OPERAND, NO TOTE OR S*00100000 SCP MH.' @Y17XAMN 00101000 AGO .MEND @Y17XAMN 00102000 .* IS TASK = REG(NUMBER)? IF YES, CHECK FOR A SSCP OR TOTE MH. @Y17XAMN 00102100 .TK2 ANOP @Y17XAMN 00102200 AIF ('&TASK'(1,1) NE '(').ERR3 @YM06054 00102300 AIF (&IEDQZA(30)).TSKMH @Y17XAMN 00102400 MNOTE 12,'*** IED702 TASK=(NUMBER) MUST ONLY BE USED BY A SSCP*00102500 MH.' @YM06054 00102600 AGO .MEND @Y17XAMN 00102700 .* IS TASK = REG(NUMBER) SYNTACTICALLY CORRECT AND @Y17XAMN 00104000 .* PROPERLY DEFINED. @Y17XAMN 00105000 .TSKMH ANOP @Y17XAMN 00107000 &E SETA K'&TASK @Y17XAMN 00108000 AIF ('&TASK'(&E,1) NE ')').ERR4 @Y17XAMN 00109000 &E SETA &E-2 @YM06054 00110000 ® SETC '&TASK'(2,&E) @YM06054 00111000 CNOP 0,4 @YM06054 00112000 ST ®,*+12 @YM06054 00113000 &STATUS SETA &STATUS+1 @YM06054 00114000 AGO .TSKGEN @Y17XAMN 00118000 .ERR3 MNOTE 12,'***IED704 INVALID USE OF TASK OPERAND,UNDEFINED OPERA00119000 AND FIELD.' @Y17XAMN 00120000 AGO .MEND @Y17XAMN 00121000 .ERR4 MNOTE 12,'*** IED705 INVALID USE OF TASK OPERAND, REG USED INCO00122000 ORRECTLY.' @Y17XAMN 00123000 AGO .MEND @Y17XAMN 00124000 .TSKSSC ANOP @Y17XAMN 00128000 .* CALL IEDQVCON AND BUILD THE FIRST 4 BYTES OF PARAMETERS @Y17XAMN 00133000 .* LIST. @Y17XAMN 00134000 .TSKGEN ANOP @Y17XAMN 00136000 &LEN SETA 8 PARAMETER LIST LENGTH @YM06054 00136500 IEDQVCON 42,IEDQA5 @Y17XAMN 00137000 CNOP 0,4 @Y17XAMN 00138000 &NAME BAL 1,*+&LEN+4 @YM06054 00139000 DC AL1(&IEDQZE(42)),AL1(&LEN) @Y17XAMN 00140000 DC AL1(0),AL1(&STATUS) @YM06054 00141000 AIF ('®' EQ '').TSKTAB @YM06054 00141600 DS A(0) ADDR OF USER'S TASK INFO 00142200 AGO .TSKEXT @YM06054 00142800 .TSKTAB ANOP @YM06054 00143400 .* UPDATE IEDQMISC DSECT,GENERATE LENGTH BYTE AND ADDRESS @Y17XAMN 00144000 .* INTO PARAMETER LIST. @Y17XAMN 00145000 &C SETC '&SYSECT' @Y17XAMN 00147000 IEDQMISC CSECT @Y17XAMN 00148000 DC C'&QCBNM' @Y17XAMN 00149000 &C CSECT @Y17XAMN 00150000 DC AL1(&IEDQZD) @Y17XAMN 00151000 DC AL3(IEDQMISC+&IEDQZK) @Y17XAMN 00152000 &IEDQZK SETA &IEDQZK+&IEDQZD @Y17XAMN 00153000 .* BUILD LINKAGE TO UI. @Y17XAMN 00155000 .TSKEXT ANOP @Y17XAMN 00157000 L 15,IEDUI @Y17XAMN 00158000 BALR 14,15 @Y17XAMN 00159000 AGO .MEND @Y17XAMN 00160000 .TRYTHR ANOP @Y17XAMN 00161000 AIF ('&THRESH' EQ '').TRY S22025 00162000 AIF ('&THRESH'(1,2) NE 'X''').BBB . S22025 00163000 AIF (K'&THRESH EQ 7 AND '&THRESH'(7,1) EQ '''').CCC . S22025 00164000 .AAA MNOTE 12,'*** IHB300 INVALID THRESH OPERAND' 00165000 AGO .MEND S22025 00166000 .CCC ANOP S22025 00167000 &TH SETB 1 . S22025 00168000 &HEX SETB 1 . S22025 00169000 &CT SETA &CT+4 . S22025 00170000 &BIT SETA &BIT+4 . S22025 00171000 AGO .TRY . S22025 00172000 .BBB AIF ('&THRESH'(1,4) NE 'XL2''').DEC . S22025 00173000 AIF (K'&THRESH NE 9 OR '&THRESH'(9,1) NE '''').AAA . S22025 00174000 &TH SETB 1 . S22025 00175000 &HEX SETB 1 . S22025 00176000 &CT SETA &CT+4 . S22025 00177000 &BIT SETA &BIT+4 . S22025 00178000 AGO .TRY . S22025 00179000 .DEC ANOP . S22025 00180000 &A SETC '&THRESH' . S22025 00181000 &AA SETA &A . S22025 00182000 AIF (&AA GT 65535).AAA . S22025 00183000 &CT SETA &CT+4 . S22025 00184000 &TH SETB 1 . S22025 00185000 &BIT SETA &BIT+4 . S22025 00186000 .TRY AIF ('&DEST' NE 'PUT').TEST 00187000 IEDQVCON 42,IEDQA5 S22025 00188000 AIF (&TH).THPT @YA11171 00189000 CNOP 0,4 S22025 00190000 &NAME BAL 1,*+6 SA57691 00191000 DC AL1(&IEDQZE(42)),AL1(2) S22025 00192000 AGO .DSTPT @YA11171 00193000 .THPT CNOP 0,4 @YA11171 00194000 &NAME BAL 1,*+8 @YA11171 00195000 DC AL1(&IEDQZE(42)+1),AL1(4) @YA11171 00196000 AIF (&HEX).XTHR @YA11171 00197000 DC AL2(&THRESH) @YA11171 00198000 AGO .DSTPT @YA11171 00199000 .XTHR DC &THRESH @YA11171 00200000 .DSTPT ANOP @YA11171 00201000 L 15,IEDUI S22025 00202000 BALR 14,15 00203000 AGO .MEND 00204000 .TEST AIF ('&DEST' EQ '').ASTST1 DEST=** IS DEFAULT @YM04688 00205000 AIF ('&DEST'(1,4) NE 'REG(').ASTST . S22027 00206000 &E SETA K'&DEST . S22027 00207000 AIF ('&DEST'(&E,1) NE ')').ERR1 . S22027 00208000 &E SETA &E-5 . S22027 00209000 ® SETC '&DEST'(5,&E) . S22027 00210000 AIF ('&DEST'(5,1) EQ '0').ERR1 . S22027 00211000 AIF ('®'(1,1) LT '0').SETBIT S22027 00212000 AIF ('®' LT '2' OR '®' GT '12').ERR1 S22027 00213000 .SETBIT ANOP S22027 00214000 &BIT SETA &BIT+1 . S22027 00215000 &FLG SETB 1 . S22027 00216000 AGO .HERE . S22027 00217000 .ASTST ANOP . S22027 00218000 AIF ('&DEST' NE '**').T1 00219000 .ASTST1 ANOP DEST=** IS DEFAULT @YM04688 00220000 &BIT SETA &BIT+32 00221000 &LEN SETA &LEN+4 00222000 AGO .HERE 00223000 .T1 AIF ('&DEST'(1,1) EQ '(').PAR 00224000 AIF ('&DEST' EQ 'ORIGIN').ORIG1 . S22027 00225000 .GO IEDQCHAR 8,&DEST 00226000 AIF (&IEDQZA(24)).ERR1 00227000 &D SETA &IEDQZD 00228000 AIF (&IEDQZD LE 8).T2 00229000 .ERR1 MNOTE 12,'*** IHB300 DESTINATION OPERAND INVALID AS SPECIFIE*00230000 D' 00231000 AGO .MEND 00232000 .T2 AIF ('&DEST'(K'&DEST,1) EQ '''').SETS 00233000 AIF ('&DEST'(1,1) GE 'A' AND '&DEST'(1,1) LE 'Z').SETO 00234000 AIF ('&DEST'(1,1) NE '$' AND '&DEST'(1,1) NE '@' AND '&DEST'*00235000 (1,1) NE '#').ERR1 00236000 .SETO ANOP 00237000 &BIT SETA &BIT+64 00238000 &FLG SETB 1 00239000 &LEN SETA &LEN+4 00240000 AGO .HERE 00241000 .SETS ANOP 00242000 &BIT SETA &BIT+128 00243000 &FLG SETB 1 00244000 AGO .HERE 00245000 .ORIG1 ANOP . S22027 00246000 &BIT SETA &BIT+2 . S22027 00247000 AGO .HERE . S22027 00248000 .PAR AIF (K'&DEST NE 3).ERR1 00249000 AIF ('&DEST'(K'&DEST,1) NE ')').ERR1 00250000 AIF ('&DEST'(2,1) LT '1' OR '&DEST'(2,1) GE '9').ERR1 00251000 &BIT SETA &BIT+32 00252000 &LEN SETA &LEN+4 00253000 .HERE AIF ('&EOA' EQ '').EXITCHK 00254000 .CHEOA IEDQCHAR 8,&EOA 00255000 &BIT SETA &BIT+8 00256000 &LEN SETA &LEN+4 00257000 AIF (&IEDQZA(24)).ERR 00258000 AIF (&IEDQZD LE 8).EXITCHK 00259000 .ERR MNOTE 12,'*** IHB300 EOA OPERAND INVALID AS SPECIFIED' 00260000 AGO .MEND 00261000 .EXITCHK AIF ('&EXIT' EQ '').OK 00262000 &BIT SETA &BIT+16 00263000 &LEN SETA &LEN+4 00264000 AIF (K'&EXIT LE 8).OK 00265000 MNOTE 12,'*** IHB108 EXIT OPERAND INVALID AS SPECIFIED' 00266000 AGO .MEND 00267000 .OK AIF ('&DEST' EQ '').V2 @YM04688 00267500 AIF ('&DEST'(K'&DEST,1) EQ '''').V1 00268000 AIF ('&DEST' EQ 'ORIGIN').V1 . S22027 00269000 AIF ('&DEST'(1,4) EQ 'REG(').V1 . S22027 00270000 AIF ('&DEST' EQ '**' OR '&DEST'(1,1) EQ '(').V2 00271000 IEDQVCON (42,31),(IEDQA5,IEDQAE) 00273000 AGO .BAL 00274000 .V1 IEDQVCON 42,IEDQA5 00275000 AGO .BAL 00276000 .V2 AIF ('&EOA' EQ '').V1 00277000 IEDQVCON (42,21),(IEDQA5,IEDQBA) 00278000 .BAL CNOP 0,4 00279000 &NAME BAL 1,*+4+&LEN+&CT S22025 00280000 DC AL1(&IEDQZE(42)) 00281000 AIF (&LEN EQ 24).SC 00282000 AIF (&LEN EQ 20).SE 00283000 AIF (&LEN EQ 12).SF 00284000 AIF ('&EXIT' EQ '').SF 00285000 .SE DC AL1(8+&CT),AL1(&BIT) . S22025 00286000 AIF ('&EOA' EQ '').SZ 00287000 DC AL1(&IEDQZE(21)) 00288000 AGO .E 00289000 .SZ DC AL1(0) 00290000 AGO .E 00291000 .SC DC AL1(12+&CT),AL1(&BIT),AL1(&IEDQZE(21)) . S22025 00292000 AGO .E 00293000 .SF DC AL1(4+&CT),AL1(&BIT),AL1(&IEDQZE(21)) S22025 00294000 .E AIF ('&EOA' EQ '').X 00295000 &C SETC '&SYSECT' 00296000 IEDQMISC CSECT 00297000 AIF ('&EOA'(K'&EOA,1) EQ '''').SETE 00298000 DC C'&EOA' 00299000 AGO .C 00300000 .SETE DC &EOA 00301000 .C ANOP 00302000 &C CSECT 00303000 DC AL1(&IEDQZD),AL3(IEDQMISC+&IEDQZK) 00304000 &IEDQZK SETA &IEDQZK+&IEDQZD 00305000 .X AIF ('&EXIT' EQ '').CKTRSH . S22025 00306000 DC AL4(&EXIT) 00307000 .CKTRSH AIF (NOT &TH).SI . S22025 00308000 AIF (&HEX).XDC . S22025 00309000 DC AL2(&THRESH),AL2(0) . S22025 00310000 AGO .SI S22025 00311000 .XDC DC &THRESH,AL2(0) . S22025 00312000 .SI AIF ('&DEST' EQ '').NSB @YM04688 00312500 AIF ('&DEST'(K'&DEST,1) EQ '''').SB 00313000 AIF ('&DEST' EQ 'ORIGIN').SB . S22027 00314000 AIF ('&DEST'(1,4) EQ 'REG(').SB . S22027 00315000 AIF ('&DEST' NE '**' AND '&DEST'(1,1) NE '(').SL 00316000 .NSB DC AL1(&IEDQZE(30)),X'04',AL1(15) @OX19417 00318082 AIF ('&DEST' EQ '**' OR '&DEST' EQ '').FF @YM04688 00319000 &C SETC '&DEST'(2,1) 00320000 &LEN SETA &C 00321000 DC AL1(&LEN) 00322000 AGO .SB 00323000 .FF DC X'FF' 00324000 AGO .SB 00325000 .SL DC AL1(&IEDQZE(31)),X'04',AL1(&DEST),AL1(15) @YM08438 00326000 .SB DC AL1(8+&FLG),AL1(8),AL1(0) 00327000 AIF ('&DEST' EQ '').SR @YM04688 00327500 AIF ('&DEST'(1,4) EQ 'REG(').REG . S22027 00328000 AIF ('&DEST'(K'&DEST,1) NE '''').SR 00329000 DC AL1(&D) 00330000 &C SETC '&SYSECT' 00331000 IEDQMISC CSECT 00332000 DC &DEST 00333000 &C CSECT 00334000 DC A(IEDQMISC+&IEDQZK) 00335000 &IEDQZK SETA &IEDQZK+&D 00336000 AGO .SV 00337000 .REG ANOP . S22027 00338000 DC AL1(0) . TERM NAME LENGTH S22027 00339000 DC AL4(0) . TERM NAME ADR S22027 00340000 IC 15,0(,®) . S22027 00341000 STC 15,*-9 . S22027 00342000 LA ®,1(,®) . S22027 00343000 ST ®,*-16 . S22027 00344000 BCTR ®,0 @OZ48773 00344582 AGO .SV . S22027 00345000 .SR DC XL5'00' 00346000 .SV L 15,IEDUI 00347000 BALR 14,15 00348000 AIF ('&EOA' EQ '').MEND 00349000 B *+6 SA56312 00350000 IEDR&SYSNDX DC H'0' SA56312 00351000 STH 15,IEDR&SYSNDX SA56312 00352000 SETSCAN &EOA 00353000 LTR 15,15 SA56312 00354000 BNZ *+8 SA56312 00355000 LH 15,IEDR&SYSNDX SA56312 00356000 .MEND SPACE 2 00357000 MEND 00358000