/* parse a variable reference for PL/I symbolic debugger returns all the information about it in symp->symbol */ variable: procedure(symp) recursive; dcl symp pointer; %include 'scandef.pli'; %include 'workdef.pli'; %include 'symdef.pli'; %include 'block.inc'; %include 'path.inc'; dcl iand entry(fixed bin(15), fixed bin(15)) returns(fixed bin(15)); dcl block_fileaddr fixed bin(23) static, /*static for memory efficiency*/ (i, x) fixed bin(15) static, /*scratch*/ ttype fixed bin(7) static, tname char(31) varying static; /**************************************************************************************************************/ /* if defining a do group (debprocedure_define_level^=0), we check the syntax without looking up any symbols, and since we modify the symbol buffer in the process, we leave dot_valid false */ if nxtokenis('.') then do; if debprocedure_define_level = 0 /*only execute if not defining do group*/ then do; if ^ dot_valid then call error('current variable not defined (there must be a prior examine or deposit)'); call addrcalc(symp); end; return; end; dot_valid = false; symp->symbol.explicit_basing_pointer = false; symp->symbol.basing_address = 0; /*for clarity while debugging*/ basing_pointer_loop: call block(block_fileaddr); if debprocedure_define_level = 0 then do; if block_fileaddr = null_fileaddr /*if at breakpoint set by octal address (see block)*/ then call error('default block not defined - must be specified explicitly'); else call workgrab(block_fileaddr, scratch_workp); end; symp->symbol.module_fileaddr = scratch_workp->workbuf.parent; symp->symbol.specified_block_code = scratch_workp->workbuf.value; symp->symbol.subscripts = 0; call pathbegin(symp, symbol_path); structure_member_loop: tname = nxsymtoken; call pathnext(symp, tokenp, length(tname)); if nxtokenis('(') then do; subscript_loop: ttype = nexttoken(tname); if ttype ^= decimal_constant_type & ttype ^= symbol_type then call error('subscript must be decimal constant or a fixed binary(15) variable'); symp->symbol.subscripts = symp->symbol.subscripts + 1; if symp->symbol.subscripts > 8 then call error('debugger can''t handle more than 8 subscripts'); if ttype = decimal_constant_type then symp->symbol.subscript(symp->symbol.subscripts).value = tname; else do; /*variable*/ nextp = tokenp;/*back up to let variable handle the name*/ call variable(subscript_symp); /*recurse*/ if debprocedure_define_level = 0 then do; if ^( (subscript_symp->is_arithmetic & subscript_symp->is_binary_or_character) /*must be fixed bin*/ & ^(subscript_symp->is_array) /*must not be an array*/ & (subscript_symp->ssize = 15) /*must be fixed bin(15,0)*/ ) /*note: variable gives error if function*/ then call error('subscript variable must be fixed bin(15) and not an array'); call addrcalc(subscript_symp); symp->symbol.subscript(symp->symbol.subscripts).value = getword(subscript_symp->symbol.address); /*address of variable in user task*/ end; end; symp->symbol.subscript(symp->symbol.subscripts).errp = nextp-1; if nxtokenis(',') then goto subscript_loop; if ^ nxtokenis(')') then call error('missing '')'' or improper syntax for subscript list'); end; if nxtokenis('.') then goto structure_member_loop; if debprocedure_define_level = 0 then do; call pathfind(symp); call addrcalc(symp); end; i = nextp; if nxtokenis('-') then if nxtokenis('>') then do; if debprocedure_define_level = 0 /*only execute if not defining do group*/ then do; if ^ symp->symbol.is_pointer then call error('symbol to the left is not a pointer'); symp->symbol.explicit_basing_pointer = true; symp->symbol.basing_address = getword(symp->symbol.address); end; goto basing_pointer_loop; end; nextp = i; /*back up to the minus, if there was one*/ if debprocedure_define_level = 0 then dot_valid = true; end /*variable*/;