/* path routines for PL/I symbolic debugger - resolve block and structure references, which need not be fully qualified %include 'path.inc' for the proper declarations semi-recursive - the data these routines work with is stored in a sym buffer, since they may be called on to parse a variable in a subscript while in the midst of parsing the array variable. */ /* initialize path handling, identify whether block or structure */ pathbegin: procedure(symp, ptype); dcl symp pointer /*to symbol structure*/, ptype fixed bin(15) /*block_path or symbol_path*/; %include 'symdef.pli'; /**************************************************************************************************************/ symp->pathtype = ptype; symp->pathlast = 0; end; /* accept next name in path location of name in commandline is saved for pathfind, which must scan right to left in order to handle un-fully-qualified references */ pathnext: procedure(symp, namepos, namelen); dcl symp pointer, /*to symbol structure*/ namepos fixed bin(15), /*position in commandline of beginning of name*/ namelen fixed bin(15); /*length of name*/ %include 'symdef.pli'; /**************************************************************************************************************/ symp->pathlast = symp->pathlast + 1; if symp->pathlast > hbound(symp->symbol.pathnames,1) then call error('too many explicit levels in block or structure - try ommitting unnecessary ones'); symp->pathnames(symp->pathlast).cmdpos = namepos; symp->pathnames(symp->pathlast).namlen = namelen; end; /* resolve possibly un-fully-qualified block or structure reference if a block, returns it in symp->symbol.specified_block_code if a structure, returns it in symp->symbol.buffer %include 'path.inc' for declarations we scan blocks/symbols that match the given specification either until we find an exact (fully qualified) match or until we've looked at them all. if we don't see an exact match, we must look at all possibilities in order to catch ambiguous references, and in the case of symbols to take the one in the closest enclosing block (up-level reference, following PL/I scoping rules). the .SYM file is scanned incrementally as necessary, and symbol names entered into the work file as they are encountered, so that all subsequent references are hashed. Thus during any debug session the .SYM file is scanned at most once, and at best barely at all. */ pathfind: procedure(symp); dcl symp pointer; /*to symbol structure*/ %include 'scandef.pli'; %include 'workdef.pli'; %include 'putdef.pli'; %include 'symdef.pli'; %include 'moddef.pli'; %include 'path.inc'; %include 'symswitch.inc'; %include 'readsym.inc'; %include 'plioctal.inc'; dcl min16 entry(fixed bin(15), fixed bin(15)) returns(fixed bin(15)); /**************************************************************************************************************/ /* returned by next_same_name if finding structure: */ dcl thisone_uplevels fixed bin(15) initial(0); /*initialed each invocation in case block_path*/ /* find the next block or symbol with the given name */ next_same_name: procedure(aname) returns(fixed bin(1)/*false if none found*/); dcl aname char(*) varying, match_block fixed bin(15); if symp->pathtype = block_path then return( worknext(aname, block_class, any_parent, path_workp) ); call symswitch(symp->symbol.module_fileaddr); symbol_lookup_loop: if worknext(aname, symbol_class, current_module.hash_fileaddr, path_workp) then call read_symbol(path_workp->workbuf.value, symp); else do; /*not in workfile - scan symfile till we find it, adding workfile hash entries along the way*/ symscan: if symfile_next < symfile_base then return(false); /*not found*/ if symfile_next > symfile_end then call error('.SYM file may be corrupted - bad link in symbol table entry at '!!pli_octal(symfile_next)); call read_symbol(symfile_next, symp); symfile_next = symp->symbol.nextsym; any_symscan = true; put_workp->workbuf.value = symp->symbol.symaddr; call workput(symp->symbol.name, symbol_class, current_module.hash_fileaddr); if symp->symbol.name ^= aname then goto symscan; end; thisone_uplevels = 0; match_block = symp->specified_block_code; do while (match_block ^= symp->actual_block_code); /*see if symbol in specified block or up-level block*/ if match_block = 0 then goto symbol_lookup_loop; /*not accessible from specified block*/ match_block = current_module.blocks(match_block).parent; thisone_uplevels = thisone_uplevels + 1; end; return(true); end; dcl fully_qualified fixed bin(1), ambiguous fixed bin(1), closest fixed bin(15), /*symbol_path: virtual addr in symbol table, block_path: flag*/ closest_fully_qualified fixed bin(15), /*symbol_path: virtual addr in symbol table*/ closest_uplevels fixed bin(15), /*symbol_path: distance of up-level reference from specified block*/ found_block fixed bin(23), /*block_path: fileaddr of block hash record*/ farthest_match fixed bin(15), /*how far match succeeded, for error reporting*/ ipath fixed bin(15), parent_symp pointer static, undefined fixed bin(15) static initial(32767), /*must be positive for farthest_match and closest_uplevels*/ defined fixed bin(15) static initial(1); path_name: procedure(i) returns(char(31) varying); /*return actual name given subscript in pathnames array*/ dcl i fixed bin(15), tname char(31) varying; tname = substr(commandline,symp->pathnames(i).cmdpos,symp->pathnames(i).namlen); call upcase(tname); return(tname); end; get_block_data: procedure; /*fudge block processing to look like structure, to simplify code*/ read file(workfile) into(block_data); if block_data.parent = null_fileaddr then parent_symp->symbol.parent_structure = 0; else parent_symp->symbol.parent_structure = 1; end; /**************************************************************************************************************/ ambiguous = false; farthest_match = undefined; closest = undefined; closest_fully_qualified = undefined; closest_uplevels = undefined; found_block = null_fileaddr; if symp->pathtype = symbol_path then call symswitch(symp->symbol.module_fileaddr); path_workp->workbuf.next = work_index(workhash(path_name(symp->pathlast))); keep_looking: if ^ next_same_name(path_name(symp->pathlast)) then do; if ambiguous & (closest_fully_qualified = undefined) then if symp->pathtype = block_path then call error('block reference to the left is ambiguous'); else call error('structure reference to the left is ambiguous'); return_it: if closest ^= undefined then do; if symp->pathtype = block_path then symp->module_fileaddr = found_block; else do;/*symbol_path*/ if closest_fully_qualified ^= undefined then closest = closest_fully_qualified; if symp->symbol.symaddr ^= closest then call read_symbol(closest, symp); end; return; end; if symp->symbol.pathtype = block_path then call error('can''t match block reference to the left - perhaps you forgot to SET MODULE'); ipath = farthest_match; if ipath = undefined then ipath = symp->pathlast; errorp = symp->pathnames(ipath).cmdpos + symp->pathnames(ipath).namlen; if farthest_match = undefined then call error('symbol to the left not found or not accessible'); else call error('symbol to the left not a member of previous structure'); end; fully_qualified = true; ipath = symp->pathlast - 1; parent_symp = symp; if symp->pathtype = block_path then call get_block_data; do while (parent_symp->symbol.parent_structure ^= 0 & ipath > 0); if symp->pathtype = symbol_path then do; call read_symbol(parent_symp->symbol.parent_structure, scratch_symp); parent_symp = scratch_symp; end; else do; /*block_path*/ call workgrab(block_data.parent, scratch_workp); parent_symp->symbol.name = scratch_workp->workbuf.name; call get_block_data; end; if parent_symp->symbol.name = path_name(ipath) then ipath = ipath - 1; else fully_qualified = false; end; farthest_match = min16(farthest_match, ipath+1); if ipath > 0 then goto keep_looking; /*didn't match*/ if parent_symp->symbol.parent_structure ^= 0 then fully_qualified = false; if symp->pathtype = block_path then do; if closest ^= undefined then ambiguous = true; found_block = path_workp->workbuf.fileaddr; closest = defined; end; else do; /*symbol_path*/ if thisone_uplevels = closest_uplevels then ambiguous = true; if thisone_uplevels < closest_uplevels then do; ambiguous = false; closest_fully_qualified = undefined; end; if thisone_uplevels <= closest_uplevels then do; closest_uplevels = thisone_uplevels; closest = symp->symbol.symaddr; if fully_qualified then closest_fully_qualified = closest; end; end; if fully_qualified & thisone_uplevels = 0 then goto return_it; /*exact match always unambiguous*/ goto keep_looking; end;