/*********************************************************** * syntax scanning procedures for PL/I symbolic debugger * ***********************************************************/ /* get next token */ nexttoken: procedure(tokenstring) returns(fixed bin(7) /*tokentype*/); dcl tokenstring char(*) varying, /*returned token*/ tokentype fixed bin(7); /*type code*/ %include 'scandef.pli'; dcl octbin entry(char(*) varying) returns(fixed bin(15)); dcl (stringp, i) fixed bin(15); /**************************************************************************************************************/ do while( 0^=index(' ', nextchar()) ); /*skip blanks and tabs*/ end; tokenp = nextp - 1; /* symbol */ if 0^=index('ABCDEFGHIJKLMNOPQRSTUVWXYZ_$%', lastchar) then do; do while( 0^=index('ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_$%', nextchar()) ); end; tokentype = symbol_type; end; /* some kind of string */ else if lastchar = '''' then do; tokenstring = ''; stringp = nextp; /*point to character following quote*/ stringloop: do while( nextchar ^= '''' ); if nextp > length(commandline) then call error('unterminated quoted string - must be contained on one line'); end; tokenstring = tokenstring !! substr(commandline, stringp, nextp-stringp-1); /*include everything up to but not including the quote*/ if nextchar ^= 'B' then do; /* character string */ stringp = nextp; /*point to following char - include it in next concatenate if quote*/ if lastchar = '''' then goto stringloop; /*double quote - keep going till hit close quote*/ nextp = nextp - 1; return(string_constant_type); end; if nextchar ^= '3' then do; /* bit string */ nextp = nextp - 1; return(decimal_constant_type); /*treat bit string as numeric for now*/ end; /*else*/ /* octal constant */ i = verify(tokenstring, '01234567'); if i ^= 0 then do; errorp = tokenp + i; call error('invalid octal digit'); end; i = octbin(tokenstring); tokenstring = i; /*return decimal equivalent of octal value*/ return(octal_constant_type); end; /* decimal constant */ else if 0^=index('0123456789', lastchar) then do; do while( 0^=index('0123456789.', nextchar()) ); end; tokentype = decimal_constant_type; end; /* anything else is punctuation */ else do; tokenstring = lastchar; /*cant substr since may be semicolon generated by nextchar at end of commandline*/ return(punctuation_type); end; nextp = nextp - 1; tokenstring = substr(commandline, tokenp, nextp-tokenp); call upcase(tokenstring); return(tokentype); end /*nexttoken*/; /* see if next token has given value(s), skipping over it if so if matchstring does not begin with a blank, matches whole string if matchstring begins with blank, matches any word (surrounded by blanks) in it */ nxtokenis: procedure(matchstring) returns(fixed bin(1) /*true if match*/); dcl matchstring char(*), match fixed bin(1); %include 'scandef.pli'; dcl ttype fixed bin(7), tokenstring char(31) varying; /**************************************************************************************************************/ ttype = nexttoken(tokenstring); if substr(matchstring,1,1) ^= ' ' then match = (tokenstring = matchstring); else match = ( 0^=index(matchstring, ' '!!tokenstring!!' ') ); if ^ match then nextp = tokenp; /*advance only if match*/ return(match); end /*nxtokenis*/; /* get next token, giving error if not valid symbol name */ nxsymtoken: procedure returns(char(31) varying /*tokenstring*/); dcl tokenstring char(31) varying; %include 'scandef.pli'; /**************************************************************************************************************/ if nexttoken(tokenstring) ^= symbol_type then call error('invalid syntax for a name'); return(tokenstring); end /*nxsymtoken*/; /* bottom-level scanner - get next character in commandline returns semicolon if past end of line */ nextchar: procedure returns(char(1)); %include 'scandef.pli'; /**************************************************************************************************************/ if errorp < nextp then errorp = nextp; /*error is taken to be at farthest point we've scanned*/ if nextp > length(commandline) then lastchar = ';'; else lastchar = substr(commandline, nextp, 1); nextp = nextp + 1; /*always increment, even if past end, to simplify nxtoken code*/ call upcase(lastchar); return(lastchar); end /*nextchar*/; /* check to see that we've parsed to end of command */ endscan: procedure; %include 'scandef.pli'; /**************************************************************************************************************/ if ^ nxtokenis(';') then call error('improper argument syntax - type HELP for assistance'); if debprocedure_define_level^=0 /*if defining a do-group or debprocedure, this is the end of syntax checking - */ then signal condition(endcmd); /* - skip execution of the command, return directly to do_command*/ end endscan; /* save the current scan state, for nesting of do-groups, debprocedures, & include files. sets in_include to false each time so that include files will be closed correctly when exiting from them within nested do groups */ push_scan_state: procedure; %include 'scandef.pli'; %include 'workdef.pli'; /**************************************************************************************************************/ if scan_state_nesting_level >= hbound(scan_state_stack,1) then call error('maximum allowed nesting of debug procedures/do-groups/includes exceeded'); scan_state_nesting_level = scan_state_nesting_level + 1; call workswitch(debprocedure_workp); saved_workfile_addr = current_fileaddr(workfile); if scan_state_stack(scan_state_nesting_level) = null_fileaddr then do; call workswitch(put_workp); /*space for scan_state not allocated - switch to put stream so write allocates it*/ scan_state_stack(scan_state_nesting_level) = current_fileaddr(workfile); end; else call posfile(workfile, scan_state_stack(scan_state_nesting_level)); /*we can destroy current position, since caller will set position*/ write file(workfile) from(scan_state); in_include = false; nextp = ignore_rest_of_line;/*skips execution of rest of line*/ end /*push_scan_state*/; /* restore scanning state returns nextp as negative so that DOCMD with handle it correctly */ pop_scan_state: procedure; %include 'scandef.pli'; %include 'workdef.pli'; /**************************************************************************************************************/ if scan_state_nesting_level > 0 then do; call workpos(scan_state_stack(scan_state_nesting_level),debprocedure_workp); read file(workfile) into(scan_state); call workpos(saved_workfile_addr,debprocedure_workp); /**dont do if at level 0? (not necessary but not harmful)*/ scan_state_nesting_level = scan_state_nesting_level - 1; end; else call error('bug in the debugger - pop_scan_state called when at base level'); end/*pop_scan_state*/;