MACRO 00700020 &NAME SETSCAN &CHARS,&MOVE=KEEP,&POINT=FORWARD,&RESULT=(15),&BLANK=Y*01400020 ES,&LAST=NO @OY15007 02100000 GBLA &IEDQZD,&IEDQZE(64),&IEDQZK 02800020 GBLB &IEDQZA(64) 03500020 GBLC &IEDQZB,&IEDQZC 04200020 LCLA &LEN,&BIT,&LNG,&I,&O A44874 04900021 LCLB &NOGO,&NOREG 05600020 LCLC &WORK,&C 06300020 .*A084000 A44874 06500021 .*C049000,070000,511000,553000-581000 A44874 06700021 .*D630000-658000 A44874 06900021 .*A119000,343000,371000,679000,707000 @OY15007 07000000 .*D091000-119000 @OY18039 07100082 .*C681000 @OZ29943 07100182 .* VERSION DATED FEBRUARY 15,1978 @OZ29943 07700082 SPACE 07750082 &IEDQZE(40) SETA 0 08400020 &I SETA 30 A44874 08600021 &O SETA 1 A44874 08800021 AIF ('&LAST' EQ 'NO').NEXT @OY15007 11940000 AIF ('&LAST' EQ 'YES').DFLT @OY15007 11980000 MNOTE 12,'*** IHB300 LAST OPERAND INVALID AS SPECIFIED' 12020000 AGO .MEND @OY15007 12060000 .DFLT ANOP @OY15007 12100000 AIF (&IEDQZA(14)).GOOD @OY15007 12140000 AIF (&IEDQZA(6) AND NOT &IEDQZA(3) AND NOT &IEDQZA(4)).GOOD 12180000 MNOTE 12,'*** IHB070 SEQUENCE ERROR - MUST FOLLOW INBLK,INBU*12220000 F OR OUTBUF MACRO' @OY15007 12260000 AGO .MEND @OY15007 12300000 .GOOD ANOP @OY15007 12340000 AIF ('&MOVE' NE 'KEEP' AND '&MOVE' NE 'RETURN').BADMVE 12380000 AGO .RESULT @OY15007 12420000 .NEXT ANOP @OY15007 12460000 AIF (&IEDQZA(3) OR &IEDQZA(4)).TRY 12600020 MNOTE 12,'*** IHB070 SEQUENCE ERROR - MUST FOLLOW INHDR OR O*13300020 UTHDR MACRO' 14000020 &NOGO SETB 1 14700020 .TRY AIF ('&CHARS' EQ '').MNOTE 15400020 AIF ('&MOVE' EQ 'KEEP' OR '&MOVE' EQ 'RETURN').POINT 16100020 .BADMVE ANOP @OY15007 16400000 MNOTE 12,'*** IHB300 MOVE OPERAND INVALID AS SPECIFIED' 16800020 AIF ('&LAST' EQ 'YES').MEND @YM08546 17100000 &NOGO SETB 1 17500020 .POINT AIF ('&POINT' EQ 'FORWARD' OR '&POINT' EQ 'BACK').RESULT 18200020 MNOTE 12,'*** IHB300 POINT OPERAND INVALID AS SPECIFIED' 18900020 &NOGO SETB 1 19600020 .RESULT AIF ('&RESULT'(1,1) NE '(' OR '&RESULT'(K'&RESULT,1) NE ')').20300020 .ERR 21000020 AIF (K'&RESULT GT 4).ERR 21700020 AIF (K'&RESULT EQ 3 AND '&RESULT'(2,1) LT '2').ERR 22400020 AIF (K'&RESULT EQ 4 AND ('&RESULT'(2,2) GT '12' AND '&RESULT*23100020 '(2,2) NE '15')).ERR 23800020 AIF ('&LAST' EQ 'YES').MOVE @OY15007 24100000 AGO .NEW 24500020 .ERR MNOTE 12,'*** IHB300 RESULT OPERAND INVALID AS SPECIFIED' 25200020 AIF ('&LAST' EQ 'YES').MEND @OY15007 25500000 &NOGO SETB 1 25900020 .NEW AIF ((('&CHARS' GE '0' AND '&CHARS' LE '8') OR '&CHARS' EQ '*26600020 255') AND '&MOVE' EQ 'RETURN').SETLEN 27300020 AGO .CONS 28000020 .SETLEN ANOP 28700020 &LEN SETA 1 29400020 AGO .GETCNT 30100020 .CONS AIF ('&MOVE' EQ 'RETURN' AND '&POINT' NE 'FORWARD').INCONS 30800020 AIF ('&CHARS' EQ '255' AND '&BLANK' EQ 'NO').INCONS 31500020 AIF ('&CHARS'(1,1) GE '0' AND '&CHARS'(1,1) LE '9').NXT 32200020 AIF ('&POINT' EQ 'BACK').INCONS 32900020 .NXT AIF ('&CHARS'(1,1) GE '0' AND '&CHARS'(1,1) LE '9' AND '&MOV*33600020 E' EQ 'RETURN').INCONS 34300020 .MOVE ANOP @OY15007 34600000 AIF ('&MOVE' EQ 'RETURN' AND '&RESULT' EQ '').INCONS 35000020 AIF ('&MOVE' EQ 'KEEP' AND '&RESULT' NE '' AND '&RESULT' NE *35700020 '(15)').INCONS 36400020 AIF ('&LAST' NE 'YES').BLANK @OY15007 36500000 AIF ('&MOVE' NE 'KEEP').GETSET @OY15007 36600000 &BIT SETA 255 @OY15007 36700000 AGO .GETSET @OY15007 37100000 .INCONS MNOTE 12,'*** IHB066 INCONSISTENT OPERANDS' 37800020 AIF ('&LAST' EQ 'YES').MEND @OY15007 38100000 &NOGO SETB 1 38500020 .BLANK AIF ('&BLANK' NE 'NO').BL1 39200020 &IEDQZE(40) SETA 2 39900020 AGO .CHARS 40600020 .BL1 AIF ('&BLANK' EQ '' OR '&BLANK' EQ 'YES').CHARS 41300020 IEDQCHAR 1,&BLANK 42000020 AIF (NOT &IEDQZA(24)).CHARS 42700020 MNOTE 12,'*** IHB300 BLANK OPERAND INVALID AS SPECIFIED' 43400020 &NOGO SETB 1 44100020 .CHARS AIF ('&CHARS'(1,1) GE '0' AND '&CHARS'(1,1) LE '9').GETCNT 44800020 IEDQCHAR 8,&CHARS 45500020 AIF (&IEDQZA(24)).MNOTE 46200020 AIF (&IEDQZD LE 8).GETSET 46900020 AGO .MNOTE 47600020 .GETCNT IEDQMASK &CHARS,2 48300020 AIF (NOT &IEDQZA(24)).ADD 49000020 .MNOTE MNOTE 12,'*** IHB300 FIRST OPERAND INVALID AS SPECIFIED' 49700020 &NOGO SETB 1 50400020 .ADD AIF ('&POINT' EQ 'FORWARD').ORGA A44874 50600021 AIF (&NOGO).MEND A44874 50800021 IEDQVCON 28,IEDQA0 A44874 51000021 &I SETA 28 A44874 51200021 &O SETA 0 A44874 51400021 .ORGA ANOP A44874 51600021 AIF ('&BLANK' EQ '' OR '&BLANK' EQ 'YES' OR '&BLANK' EQ 'NO'*51800020 ).BAL 52500020 &LNG SETA 2 53200020 .BAL AIF (&NOGO).MEND 53900020 &NAME BAL 1,*+8+&LNG 54600020 &NOREG SETB 1 54900020 DC AL1(&IEDQZE(&I)+&IEDQZE(40)+&O),AL1(4+&LNG) . A44874 55500021 AIF (&LEN NE 0).SPL A44874 56100021 DC AL2(&CHARS) . A44874 56700021 AGO .SETB A44874 57300021 .SPL DC X'00',AL1(&CHARS) . A44874 57900021 .SETB AIF (&LNG NE 2).LOAD 58800020 AIF ('&BLANK'(K'&BLANK,1) NE '''').FRB 59500020 DC &BLANK,AL1(0) 60200020 AGO .LOAD 60900020 .FRB DC C'&BLANK',AL1(0) 61600020 AGO .LOAD 62300020 .GETSET IEDQVCON 29,IEDQAJ 66500020 .BLDPARM AIF (&NOGO).MEND 67200020 CNOP 0,4 67900020 AIF ('&LAST' NE 'YES').NOTLST @OY15007 68000000 &NAME BAL 1,*+8 @OZ29943 68100082 DC AL1(&IEDQZE(29)+1),AL1(4),AL1(&BIT) @OY15007 68200000 AGO .RSLT @YM85467 68300000 .NOTLST ANOP @OY15007 68400000 &NAME BAL 1,*+12 68600020 AIF ('&MOVE' NE 'KEEP').K 69300020 &BIT SETA 255 70000020 .K DC AL1(&IEDQZE(29)+1+&IEDQZE(40)),AL1(8),AL1(&BIT) 70700020 .RSLT ANOP @OY15007 71000000 &WORK SETC '&RESULT'(2,K'&RESULT-2) 71400020 &LEN SETA &WORK 72100020 AIF (&LEN EQ 15).SETREG 72800020 &LEN SETA &LEN*4+20 73500020 DC AL1(&LEN) . REGISTER OFFSET 74200020 AGO .CSECT 74900020 .SETREG DC AL1(16) 75600020 .CSECT ANOP 76300020 AIF ('&LAST' EQ 'YES').LOAD @OY15007 76600000 &C SETC '&SYSECT' 77000020 IEDQMISC CSECT 77700020 AIF ('&CHARS'(K'&CHARS,1) EQ '''').NOFR 78400020 DC AL1(&IEDQZD),C'&CHARS' 79100020 AGO .EXIT 79800020 .NOFR DC AL1(&IEDQZD),&CHARS 80500020 .EXIT ANOP 81200020 &C CSECT 81900020 AIF ('&BLANK' EQ 'NO').DC1 82600020 AIF ('&BLANK' EQ '' OR '&BLANK' EQ 'YES').DC2 83300020 AIF ('&BLANK'(K'&BLANK,1) NE '''').FRAME 84000020 DC &BLANK,AL3(IEDQMISC+&IEDQZK) 84700020 AGO .ENDSET 85400020 .FRAME DC C'&BLANK',AL3(IEDQMISC+&IEDQZK) 86100020 AGO .ENDSET 86800020 .DC2 DC X'40',AL3(IEDQMISC+&IEDQZK) 87500020 AGO .ENDSET 88200020 .DC1 DC AL1(0),AL3(IEDQMISC+&IEDQZK) 88900020 .ENDSET ANOP 89600020 &IEDQZK SETA &IEDQZK+1+&IEDQZD 90300020 .LOAD L 15,IEDUI 91000020 BALR 14,15 91700020 AIF (&NOREG).MNOTEW 91800020 AGO .MEND 91900020 .MNOTEW AIF ('&RESULT'(2,2) EQ '15').MEND 92000020 MNOTE 12,'*** IHB347 WARNING - RESULT IS RETURNED IN REGISTER *92100020 15' 92200020 .MEND SPACE 2 92400020 MEND 93100020