/* parse a block reference for PL/I symbolic debugger allows un-fully-qualified block references (when local procedure definitions are nested) in the same manner as PL/I allows any unambiguous specification in structure references. if we are at an octal breakpoint (i.e., set by octal address rather than statement number), and the block reference is null meaning use default, we return null_fileaddr rather than try to determine the current block, because determining the current block can cause a trap if R4 does not contain FP (frame pointer). */ block: procedure(block_fileaddr); dcl block_fileaddr fixed bin(23); /*returned fileaddr of block hash record*/ %include 'scandef.pli'; %include 'workdef.pli'; %include 'rundef.pli'; %include 'breakdef.pli'; /*for by_octal_address*/ %include 'brksymdef.pli'; %include 'symdef.pli'; %include 'moddef.pli'; %include 'symswitch.inc'; %include 'path.inc'; %include 'prologn.inc'; %include 'getword.inc'; dcl any_block_specified fixed bin(1), default_addr fixed bin(15), default_name6 char(6), tokentype fixed bin(7), tname char(31) varying, (i, blockp) fixed bin(15); /**************************************************************************************************************/ if nxtokenis('\') then do; block_fileaddr = last_block; /*isolated backslash means use block of previous reference*/ return; end; call pathbegin(scratch_symp, block_path); any_block_specified = false; /* while the following code might be a little simpler if we just checked lastchar = '\' (eliminating the need to back up), that wouldn't allow embedded blanks, thus violating the free form character of PL/I */ blockloop: blockp = nextp; tokentype = nexttoken(tname); if (tokentype ^= symbol_type) ! ^ nxtokenis('\') then do; /*next thing isnt block - backup & return*/ nextp = blockp; errorp = nextp; if debprocedure_define_level > 0 then return; if any_block_specified then do; call pathfind(scratch_symp); block_fileaddr = scratch_symp->symbol.module_fileaddr; /*pathfind returns block fileaddr here*/ last_block = block_fileaddr; /*remember last explicit reference*/ return; end; else do; /*no block specified - use default*/ if default_block = null_fileaddr & userbreakstatement ^= by_octal_address /*but not if at octal breakpoint*/ then do; /*haven't figured out what the default block is yet - do it now*/ call symswitch(default_module); /*we know what module it's in*/ default_addr = getword(userfp + dsa_prolog); default_name6 = prologname(default_addr); i = lbound(current_module.blocks,1); do while ( default_name6 ^= current_module.blocks(i).name6 ! default_addr ^= current_module.blocks(i).address ); i = i + 1; if i > hbound(current_module.blocks,1) then call error('debugger can''t determine current (default) block - try giving explicit block'); end; default_block = current_module.blocks(i).fileaddr; end; block_fileaddr = default_block; return; end; end; call pathnext(scratch_symp, blockp, length(tname)); any_block_specified = true; goto blockloop; end;