/* display fixed bin(15) as octal word and as two octal bytes used only by poking commands of PL/I symbolic debugger */ octbyte: procedure(x); dcl x fixed bin(15); dcl px pointer initial(addr(x)), 1 xx based(px), 2 xlo fixed bin(7), 2 xhi fixed bin(7); %include 'putdef.pli'; dcl octf15 entry(fixed bin(15)) returns(char(6)), octal entry(fixed bin(15)) returns(char(6) varying), iand entry(fixed bin(15), fixed bin(15)) returns(fixed bin(15)); oct1byte: procedure(x) returns(char(3)); dcl x fixed bin(7); return(octal(iand(x, 'FF'B4))); end; call put_list(octf15(x),'(',oct1byte(xlo),',',oct1byte(xhi),') '); end; /* parse an expression of bare octal numbers (i.e., not enclosed in PL/I '...'B3 syntax) used only by poking commands of PL/I symbolic debugger operators allowed are plus and minus no leading sign allowed (say 0-n to get a negative number) no check for number too big */ octexp: procedure(value) returns(fixed bin(1)); /*false if no octal expression present*/ dcl value fixed bin(15); /*returned value*/ %include 'scandef.pli'; dcl octbin entry(char(*)) returns(fixed bin(15)); dcl (num, numstart, numlen, opnextp) fixed bin(15), op char(1); /**************************************************************************************************************/ do while (nextchar = ' '); end; nextp = nextp - 1; tokenp = nextp; value = 0; lastchar = '+'; do while(true); op = lastchar; numstart = nextp; do while( 0^=index('01234567', nextchar()) ); end; numlen = nextp - numstart - 1; num = octbin(substr(commandline, numstart, numlen)); if numlen = 0 then num = 0; if op = '+' then value = value + num; else if op = '-' then value = value - num; else do; nextp = opnextp - 1; /*point to character following last number*/ return(true); end; if numlen = 0 then do; nextp = tokenp; /*back up to beginning of nonexistent or illegal exp*/ return(false); end; opnextp = nextp; end; return(0); /**keep spurious PL/I error away*/ end octexp;