/* PL/I symbolic debugger procedures for work file access */ /* add a hashed record to the work file */ workput: procedure(aname, aclass, aparent); dcl aname char(31) varying, aclass fixed bin(7), aparent fixed bin(23); %include 'workdef.pli'; dcl x fixed bin(15); on endfile(workfile) /*do nothing - allow appends*/ ; /**************************************************************************************************************/ call upcase(aname); put_workp->workbuf.name = aname; put_workp->workbuf.parentclass = aparent*256 + aclass; call workswitch(put_workp); put_workp->workbuf.fileaddr = current_fileaddr(workfile); x = workhash(aname); put_workp->workbuf.next = work_index(x); work_index(x) = put_workp->workbuf.fileaddr; write file(workfile) from(put_workp->workbuf.workrec); /*append record to file*/ end; /* retrieve a hashed record matching given characteristics, such as having a given name. if there is more than one record that matches, the first one found (= the last one entered in the file) is returned, use worknext to get others. */ workget: procedure(aname, aclass, aparent, workp) returns(fixed bin(1) /*true if found*/); dcl aname char(31) varying, aclass fixed bin(7), aparent fixed bin(23), workp pointer; %include 'workdef.pli'; dcl (true, false) fixed bin(1) external; /**************************************************************************************************************/ if aname = any_name then do; /*match any name - initialize for sequential scan of all records*/ work_scan_index = 1; workp->workbuf.next = work_index(1); end; else do; /*name specified - hash and search only the collision list*/ workp->workbuf.next = work_index(workhash(aname)); end; return(worknext(aname, aclass, aparent, workp)); end/*workget*/; /* retrieve successive records from the work file matching given characteristics use workget to find the first one. */ worknext: procedure(aname, aclass, aparent, workp) returns(fixed bin(1) /*true if found*/); dcl aname char(31) varying, aclass fixed bin(7), aparent fixed bin(23), workp pointer; %include 'workdef.pli'; dcl (true, false) fixed bin(1) external; /**************************************************************************************************************/ call upcase(aname); scan_next_index: do while(workp->workbuf.next ^= null_fileaddr); call workgrab(workp->workbuf.next,workp); if aname = workp->workbuf.name ! aname = any_name /*name must always match*/ then do; if aclass = any_class then return(true); /*match any parent, any class*/ if aclass = workp->workbuf.class then if aparent = any_parent /*match given class, any parent*/ ! aparent = workp->workbuf.parent /*match given class and given parent*/ then return(true); end; end; if aname = any_name then do; /*scan next index*/ work_scan_index = work_scan_index + 1; if work_scan_index > hbound(work_index,1) then return(false); workp->workbuf.next = work_index(work_scan_index); goto scan_next_index; end; return(false); /*not found*/ end/*worknext*/; /* retrieve a record from the work file given its file address */ workgrab: procedure(afileaddr, workp); dcl afileaddr fixed bin(23), workp pointer; %include 'workdef.pli'; dcl (true, false) fixed bin(1) external; /**************************************************************************************************************/ workp->workbuf.fileaddr = afileaddr; call workpos(afileaddr, workp); read file(workfile) into(workp->workbuf.workrec); workp->workbuf.class = mod(workp->workbuf.parentclass, 256); workp->workbuf.parent = workp->workbuf.parentclass / 256; end/*workgrab*/; /* read a line from the work file */ workread: procedure(line, workp); dcl line char(*) varying, workp pointer; %include 'workdef.pli'; /**************************************************************************************************************/ call workswitch(workp); read file(workfile) into(line); end; /* write a line to the work file */ workwrite: procedure(line); dcl line char(*) varying; %include 'workdef.pli'; /**************************************************************************************************************/ call workswitch(put_workp); /*****temp change******************** write file(workfile) from(line); **************for PL/I bug - must be varying**/ dcl vline char(80) varying; vline=line; write file(workfile) from(vline); /*************************/ end; /* make sure the workfile is at the current position for our stream */ workswitch: procedure(workp); dcl workp pointer; %include 'workdef.pli'; /**************************************************************************************************************/ if workp ^= current_workp then do; current_workp->workbuf.curfilepos = current_fileaddr(workfile); current_workp = workp; call posfile(workfile, workp->curfilepos); end; end; /* set the current position for our stream in the workfile */ workpos: procedure(afileaddr, workp); dcl afileaddr fixed bin(23), workp pointer; %include 'workdef.pli'; /**************************************************************************************************************/ if workp ^= current_workp then do; current_workp->workbuf.curfilepos = current_fileaddr(workfile); current_workp = workp; end; call posfile(workfile, afileaddr); end; /* calculate the hash index number, given a name */ workhash: procedure(aname) returns(fixed bin(15)); dcl aname char(31) varying; %include 'workdef.pli'; dcl (x,i) fixed bin(15), a_byte fixed bin(7) based; /**************************************************************************************************************/ call upcase(aname); x = 0; do i = 1 to length(aname); x = x + addr(substr(aname,i,1))->a_byte; /*add up binary values of bytes in aname*/ end; return( 1 + mod(abs(x), hbound(work_index,1)) ); end; /* return virtual file address of current position in any file */ current_fileaddr: procedure(afile) returns(fixed bin(23)); /*file must be < 16Mb*/ dcl afile file, mrkfil entry(file, fixed bin(31), fixed bin(15)), block fixed bin(31), byte fixed bin(15); call mrkfil(afile, block, byte); return( (block-1)*512 + byte ); end; /* set the current position of any file, given a virtual file address */ posfile: procedure(afile, afileaddr); dcl afile file, afileaddr fixed bin(23), pntfil entry(file, fixed bin(31), fixed bin(15)); on endfile(afile) /*do nothing*/ ; call pntfil(afile, afileaddr/512+1, mod(afileaddr,512)); end;