/****************************************/ /* REXX -- CHECKSUM for AHMASPZAP */ /* Checks AMASPZAP cards to checksum */ /* author: David McRitchie, 06/14/1990 */ /* Copyright 1990, 1991 David McRitchie .go xxx;.ct */ /* update 1991/05/14 D.McRitchie */ /* F. David McRitchie -- "The REXX Macros Toolbox" */ /* last update 1996/04/26 D.McRitchie */ /* restored/added CCHHR, SETSSI, VERIFY */ /* */ /* This macro is universally available with the */ /* stipulation that that the original */ /* author remains credited and that no charge */ /* or licensing fee accrues to any party. */ /* This macro is my first meaningful */ /* REXX code -- the columns are narrow */ /* to provide for printing using a non-typographic */ /* font. */ /* This macro was changed to use only single */ /* quotes since double quotes are not very */ /* friendly on a magazine page. Normally */ /* double quotes would be used except where */ /* quotes are embedded. */ /* 1991/08/29 Allow CHECKSUM (blanks) */ /* 1996/04/26 in addition to NAME, REP, VER, */ /* and CHECKSUM, now also handles VERIFY, */ /* BASE, CCHHRR, and SETSSI */ /* PC some nonIBM REXX messes with CURSOR */ /* remove ----these lines non-FDM users */ /* || test data in CLIST zap$ */ /* || test data in CNTL zap$$ */ /* || Doc available sop #6250 */ /* || Macro reprocessed to print in 35 n-Spaces */ /* remove ----these lines non-FDM users */ /******************************************************/ /*-- , ...xxx;.ct */ Address 'ISREDIT' Numeric digits 20 'MACRO (TOKEN)' 'reset' '(CAPS)=CAPS' /*will restore at exit*/ 'caps off' /*for msglines*/ 'X all '; 'find all word VER'; 'find all word rep'; 'find all word name'; 'find all word base'; 'find all word cchhr'; 'find all word idrdata'; 'find all 1 //' 'find all word checksum'; 'find all word setssi'; token=translate(token) /*capitals*/ null=''; /*easier to read later*/ MSGAC= , 'LINE_AFTER .zcsr = msgline ' MSGBC= , 'LINE_BEFORE .zcsr = msgline ' MSGB1= , 'LINE_BEFORE 1 = msgline ' addends=null; addendx=null; x8=null; checksum=0; cntidr=0; cntname=0; II=0; notice=0; check=null; ret=0; hex='0123456789ABCDEF'; pcrow=1;pccol=0; Do forever 'cursor =' pcrow pccol 'find next P''='' 1 nx' If RC \= 0 then leave /*exit point*/ '(PCROW,PCCOL) = CURSOR' /* some pc implementations mess */ /* with the CURSOR for line_after */ '(CARD) = line' PCROW Parse var CARD , Opcode Address Operand Comment; Do forever; /*remove commas*/ Parse var Operand Left','Right; If Right=null then Leave; Operand=Left || Right; End xok = 2 If verify(operand,hex) \=0 then xok=1 If verify(address,hex) \=0 then xok=0 Select; When Opcode='VER', | Opcode='VERIFY', | Opcode='REP' then Do If xok < 2 then Call NOGOOD Else Do 'exclude .zcsr .zcsr all' Call evendig(operand); addends=addends||address||operand Call evendig(operand); Call evendig(address); End End When Opcode = 'BASE' then Do If xok < 1 then Call NOGOOD Else addends = addends||address; Call evendig(address); End When Opcode = 'SETSSI' then Do If xok < 1 then Call NOGOOD If length(address) \= 8 then do msgbc '''SETSSI incorrect length''' ret=max(ret,8) end else 'exclude .zcsr .zcsr all' 'cursor =' pcrow pccol End When Opcode = 'CHECKSUM' then Do /*--accept blank checksum as a reset*/ If address = '' then Do Address = '00000000' MSGBC '''--CHECKSUM to be reset ''' 'CURSOR =' pcrow pccol up 8 xok=1; /*notouch checksum addends*/ End /*--accept blank checksum as a reset*/ If xok < 1 | Length(address) \=8 then Call NOGOOD Else Do Check = address Call PROCESS checksum = 0; addends=null; End End When Opcode = 'IDRDATA' then cntidr = cntidr + 1 When Opcode = 'NAME' then Do cntname = cntname + 1 If length(addends) \= 0 then Do notice = 1 MSGBC '''---No CHECKSUM ' , ||'statement before NAME ' , ||'-- checksum not reset''' 'CURSOR =' pcrow pccol End End When Opcode = 'CCHHR' then Do /* treated more like VER than name*/ cntname = cntname + 1 If length(address) \= 10 then Do notice = 1 MSGAC '''---CCHHR cccchhhhrr, ', ||'must be ten digits long ''' 'CURSOR =' pcrow pccol End If length(addends) \= 0 then Do notice = 1 MSGBC '''---No CHECKSUM ' , ||'statement before CCHHR ' , ||'-- checksum not reset''' 'CURSOR =' pcrow pccol End addends=addends||address||operand End When substr(card,1,2)='//' then Do check = null If length(addends) \= 0 then Call PROCESS If checksum \= 0 then Do notice = notice + 1 MSGBC '''--Warning CHECK', ||'SUM reset due JCL card''' 'CURSOR =' pcrow pccol End End Otherwise 'exclude .zcsr .zcsr all' End /*--- SELECT ---*/ End /*forever*/ If notice > 0 then MSGB1 '''SPZAP only resets accum', ||'ulation at CHECKSUM cards''' 'cursor =' pcrow pccol If cntidr \= cntname then MSGB1 '''**Warning** ' , || cntname 'NAME lines, and ' , || cntidr 'IDRDATA lines, ' , || 'consider adding IDRDATA''' If length(addends) \= 0 then Call PROCESS If checksum \= 0 then , 'LINE_AFTER .zl = ' , || 'msgline ''--missing CHECKSUM ' , || 'check after last SPZAP card''' /*The following remain showing */ /* NAME,CHECKSUM,IDRDATA*/ 'loc 0' /*locate to top*/ 'CAPS' caps /* ON|OFF as began*/ If ret > 0 then Do zedsmsg='CHECKSUM ERRORS' zedlmsg='CHECKSUM errors will ', ||'occur if presented for processing' 'line_before .zf = msgline (zedlmsg)' Address ISPEXEC , 'setmsg MSG(isrz001)' 'CURSOR =' pcrow pccol End else Do zedsmsg='OKay' zedlmsg='CHECKSUM appears okay, ', ||'increasing probability of success' Address ISPEXEC , 'setmsg MSG(isrz000)' 'CURSOR =' pcrow pccol End "line_after 0 = NOTELINE ""CHECKSUM macro", "(c) 1990, 1997 F. David McRitchie""" Return(1) /* cursor to home position*/ NOGOOD: procedure , Expose MSGBC ret pcrow pccol; MSGBC '''?? Next card invalid HEX''' address 'ISREDIT' 'CURSOR =' PCROW PCCOL ret = max(ret,8) Return EVENDIG: procedure, Expose MSGAC ret PCROW PCCOL; arg xxx LOP=length(xxx) address 'ISREDIT' if 0 \= lop//2 then do 'CURSOR =' PCROW PCCOL MSGAC '''Odd Number of digits above''' 'reset x .zcsr .zcsr' 'CURSOR =' PCROW PCCOL ret = max(ret,8) end Return PROCESS: procedure Expose MSGBC, addends checksum check null ret, PCROW PCCOL; address 'ISREDIT' Numeric digits 20 Do Forever L = length(addends) If L = 0 then leave X8 = substr(addends,1,8,'0') /*0 pad*/ If L > 8 then , addends = substr(addends,9,,' ') Else addends = null decval = X2D(X8) checksum = checksum + decval End /* of Forever in PROCESS*/ C8=Right(x'00000000', || D2X(checksum),8); msg='is the calculated checksum' If check \=null & check \= C8 then Do msg=msg||' **** does not match' 'CURSOR =' PCROW PCCOL ret = max(ret,8) End MSGBC ''' --------' C8 msg '''' Return