/* PL/I symbolic debugger initialization */ debinit: procedure; %include 'putdef.pli'; %include 'scandef.pli'; %include 'rundef.pli'; %include 'brksymdef.pli'; %include 'breakdef.pli'; %include 'segdef.pli'; %include 'mapdef.pli'; /*for current_segment*/ %include 'knldef.pli'; %include 'exitdef.pli'; %include 'initdef.pli'; %include 'tiqio.inc'; %include 'cantopen.inc'; /**************************************************************************************************************/ /* note: workdef & symdef are initialized in debin2 */ /* breakdef initialization: */ dcl i fixed bin(15) static; do i = lbound(breakpoint,1) to hbound(breakpoint,1); breakpoint(i).location = 0; breakpoint(i).overlay = 0; end; /*special overlay loader breakpoint initialization:*/ breakpoint(overlay_loader).instruction = to_be_determined; breakpoint(overlay_loader).to_be_cancelled = true; /*inhibit showing of breakpoint on SHOW BREAK*/ /*.location & .overlay fields initialized from values returned from doini2 below*/ /* knldef initialization: */ dcl orwbbf fixed bin(15) external; /*defined in debasm*/ prwbbuf = addr(packet(orwbbf)); /* exitdef initialization: */ pesb = addr(user_esb(1)); user_exit_status = not_installed; /* initdef initialization: */ initializing = true; dcl unsigned entry(fixed bin(15)) returns(fixed bin(31)), rad50 entry(char(*)) returns(fixed bin(31)); dcl exit_event fixed bin(15) external, /*defined in debmain*/ (x, prefixp, dsw) fixed bin(15), t fixed bin(7); /*scratch variables*/ /**************************************************************************************************************/ open file(sysprint) pagesize(0); on condition(endcmd) signal finish; /*errors in initialization are non-recoverable*/ /* determine the terminal type for edit_command */ dcl terminal_type fixed bin(15); dcl (sf_gmc, tc_ttp) fixed bin(15) external; /*defined in debasm*/ dcl (ttv100, ttv101, ttv102, ttv105, ttv125, ttv131, ttv132) fixed bin(15) external; /*defined in debasm*/ terminal_type = tc_ttp; /*sf.gmc returns value in upper byte*/ call tiqio(sf_gmc, 'get terminal type (SF.GMC)', addr(terminal_type), 2, dsw); /*tiqio reports any errors*/ if terminal_type = ttv100 ! terminal_type = ttv101 ! terminal_type = ttv102 ! terminal_type = ttv105 ! terminal_type = ttv125 ! terminal_type = ttv131 ! terminal_type = ttv132 then VT100 = true; else VT100 = false; /* get and parse the command line */ call getcml('debug what program? ', commandline, dsw); call syserror('cant get debug command line, error code=', dsw); /*nextp & errorp are initialized to 1*/ do while(nxtokenis('/')); if nxtokenis('TASK') then do; nextp = nextp + 1; /* skip over = or : */ usertaskname = nxsymtoken; end; else if nxtokenis('INSTASK') then do; nextp = nextp + 1; /* skip over = or : */ usertaskname = nxsymtoken; user_was_installed = true; end; else if nxtokenis('PROMPT') then do; tokenp = nextp + 1; /* skip over = or : */ do while(nextchar ^= ' ' & lastchar ^= ';'); /*stop on semicolon so we dont hang if there's no blank*/ end; prompt = substr(commandline, tokenp, nextp-tokenp-1); /*when debugging the debugger or debugging multiple tasks, we have 2 versions running, so we need different prompts to tell which we're talking to*/ end; else call warning('unknown debug switch - ignored'); end; t = nexttoken(userpgmname); prefixp = tokenp; if lastchar = ':' /*skip over device specification*/ then do; nextp = nextp + 1; /*skip the colon*/ t = nexttoken(userpgmname); end; if userpgmname = '[' /*skip over uic specification*/ then do; nextp = index(commandline, ']'); if nextp = 0 then goto badname; nextp = nextp + 1; /*skip the ']'*/ t = nexttoken(userpgmname); end; uic_file_prefix = substr(commandline, prefixp, tokenp-prefixp); /*device & uic for user files*/ if ( t ^= symbol_type ) ! ( 0 = index('/; '/*includes blank & tab*/, lastchar) ) ! ( lastchar = ';' & nextp <= length(commandline) ) then badname: call error('invalid program name, or it has extension or version'); call debin2; /*must be split due to compiler symbol table overflow*/ /*initializes symdef & workdef, opens mapfile & workfile, pulls kernal data out of task file*/ /* install & spawn user task, and initialize user task kernal */ dcl rsxtsk entry(char(*)) returns(char(6)), mark entry(fixed bin(15), fixed bin(15), fixed bin(15), fixed bin(15)); dcl time_event fixed bin(15) external; /*defined in debmain*/ dcl task_not_specified fixed bin(1), mark_dsw fixed bin(15), inx_command char(79) varying; /* stuff defined in debasm: */ dcl ( (doini1, doini2, dotrpv) pointer, /*code packet pointers*/ (odsw, oinimn, oinisg, oiniov, oinist, otrpva, otrpvv) fixed bin(15), /*offsets (subscripts) in packet*/ oalbp2 fixed bin(15), /*offset from overlay loader base to $ALBP2 breakpoint*/ task_active fixed bin(15) ) external; task_not_specified = (usertaskname = ''); /*if not already set by /TASK=*/ if task_not_specified then usertaskname = rsxtsk('T'); /*use RSX convention for naming tasks to allow multiuser access*/ /*and so ABORT (without argument, or ABORT RUN) works*/ usertaskrad50 = rad50(usertaskname); if ^ user_was_installed then do; inx_command = ' '!!uic_file_prefix!!userpgmname!!'/TASK='!!usertaskname; if task_not_specified /*normal - let MCR spawn different INX for each user*/ then call spawn(rad50('MCR...'), /*no iop*/, exit_event, user_esb, 'INX'!!inx_command, , dsw); else do; /*task specified - user may have multiple debuggers trying to INX at same time, must wait if INX active*/ i = 1; inx_retry: call spawn(rad50('...INX'), /*no iop*/, exit_event, user_esb, inx_command, , dsw); if dsw = task_active & i < 7 then do; call mark(time_event, 1, 2, mark_dsw); /*wait 1 sec, give INX a chance to complete*/ call syserror('error from mark time (MRKT$), dsw = ', mark_dsw); call waitfr(time_event, dsw); call syserror('error from waitfr (WTSE$) after mark time, dsw=', dsw); i = i + 1; goto inx_retry; end; end; call syserror('error spawning MCR/INX (SPWN$), dsw=', dsw); call waitfr(exit_event, dsw); call syserror('error waiting on MCR/INX (WTSE$), dsw=', dsw); call syserror('error from install(INX), status=', user_exit_status); end; user_exit_status = not_started; call fillpacket(doini1); call sendknl; /*we send before spawning, so the kernal knows it's running with debugger rather than via RUN*/ user_exit_status = still_running; /*must set status before spawning, so we don't leave a window after the spawn & before our setting the status, during which the task could exit or abort & we would lose its status*/ call spawn(usertaskrad50, /*no iop*/, exit_event, user_esb, substr(commandline, tokenp), , dsw); call syserror('error spawning user task, dsw=', dsw); call fillpacket(doini2); call sendknl; call rcvknl; main_address = packet(oinimn); breakpoint(overlay_loader).location = packet(oiniov) + oalbp2; root_segment_descriptor = packet(oinisg); /***temp fix for clustering with overlays*******************/ dcl dortsg pointer external, (ortsgp, ortsgz) fixed bin(15) external; /*defined in debasm*/ if unsigned(root_segment_descriptor + overlay_descriptor_link_up) < unsigned(user_address_limit) then do; /*non-overlaid, non-clustered task has no root segment descriptor*/ call fillpacket(dortsg); packet(ortsgp) = root_segment_descriptor + overlay_descriptor_link_up; packet(ortsgz) = overlay_descriptor_size; /*size of overlay descriptors in clustered task*/ /*(non-clustered tasks may have different size, but for them dortsg won't have to scan)*/ call sendknl; call rcvknl; root_segment_descriptor = packet(ortsgp) - overlay_descriptor_link_up; end; /************************************************/ current_segment.descriptor = root_segment_descriptor; breakpoint(overlay_loader).overlay = root_segment_descriptor; call fillpacket(dotrpv); packet(otrpva) = knlpktaddr + otrpvv*2; call sendknl; call rcvknl; call syserror('error on SVDB$ directive, dsw=', packet(odsw)); stop_address = packet(oinist); end; /* the rest of debinit, must be split due to compiler symbol table overflow */ debin2: procedure; %include 'lb:[1,2]fdb.pli'; %include 'knldef.pli'; %include 'workdef.pli'; %include 'symdef.pli'; %include 'brksymdef.pli'; /*for user_address_limit*/ %include 'mapdef.pli'; %include 'external.inc'; %include 'segdef.pli'; %include 'initdef.pli'; %include 'cantopen.inc'; dcl octal entry(fixed bin(15)) returns(char(6) varying), octbin entry(char(*)) returns(fixed bin(15)), trim entry(char(*)) returns(char(6) varying), unsigned entry(fixed bin(15)) returns(fixed bin(31)), oncode builtin; dcl opktad fixed bin(15) external; /*offset from kernal xfr address to send/receive packet, defined in debasm*/ dcl (mapfilename, taskfilename) char(35) varying, (x, i) fixed bin(15); /*scratch variables*/ /**************************************************************************************************************/ /* symdef initialization: */ allocate symbol set(main_symp); allocate symbol set(subscript_symp); allocate symbol set(basing_symp); allocate symbol set(scratch_symp); /* workdef initialization: */ allocate workbuf set(put_workp); put_workp->workbuf.curfilepos = 0; allocate workbuf set(debprocedure_workp); debprocedure_workp->workbuf.curfilepos = 0; allocate workbuf set(path_workp); path_workp->workbuf.curfilepos = 0; allocate workbuf set(scratch_workp); scratch_workp->workbuf.curfilepos = 0; /*we initialize curfilepos since debugger may call workswitch (which calls posfile) before first workpos, and since pntfil/.point (called by posfile) to a position beyond end of file no longer gives end of file error but rather transmit 24 (device full)*/ current_workp = put_workp; /* make sure the task has a PL/I debug kernal of the right version. we find it by scanning the map header for the debug start address. */ dcl taskfile file input sequential env(dev(sy), recsize(512)); dcl carriage_return fixed bin(7) static initial('0D'B4 /*ASCII carriage return*/), mapline char(132) static, /*static so space is taken in overlay rather than auto (which is in root)*/ first_char fixed bin(7) based(mapline_p); mapline_p = addr(mapline); dcl odt_xfr_address fixed bin(15), /*unsigned 16-bit value (address in user task)*/ root_disk_blk_base fixed bin(23), /*must be double size to force double precision in expression yielding */ ( /* usertask_knlvnm_fileaddr*/ knlvnm fixed bin(15), /*Version number of kernel in debugger*/ oxfvw fixed bin(15) /*offset from kernel xfr address to version word (signed)*/ ) external, /*defined in debasm*/ usertask_knlvnm_fileaddr fixed bin(23), usertask_knlvnm fixed bin(15) based(usertask_knlvnm_ptr), usertask_knlvnm_buffer char(512) static; /*static so space is taken in overlay rather than auto (which is in root)*/ usertask_knlvnm_ptr = addr(usertask_knlvnm_buffer); /*we open the .TSK first so if the user mistypes the program name he gets a message telling him there's no file xyz.TSK*/ on undefinedfile(taskfile) begin; call put_skip_list(cantopen(taskfilename, oncode)); stop; end; taskfilename = uic_file_prefix!!userpgmname!!'.TSK'; open file(taskfile) title(taskfilename); on undefinedfile(mapfile) begin; call put_skip_list(cantopen(mapfilename, oncode)); stop; end; mapfilename = uic_file_prefix!!userpgmname!!'.MAP'; open file(mapfile) title(mapfilename); /* PL/I can't open a new file for reading & writing - must do it in two steps. if we were to simply open-close-reopen, then if two users started debugging in the same directory at the same time (or if one user spawned multiple tasks with debuggers), there would be a race condition in which both try to open the same file (user 1 creates & closes, user 2 creates & closes, then they both open). to eliminate the problem we must fish the version number of the created file out of the FDB and reopen with explicit version. note we open the file in the current directory, not the one specified by uic_file_prefix. */ on undefinedfile(workfile) call error(cantopen('DEBWORK.TMP',oncode)); open file(workfile) title('DEBWORK.TMP') output; /*creates new file*/ i = FDBADR(workfile)->FDB.F_FVER; /*version number*/ close file(workfile); open file(workfile) title('DEBWORK.TMP;'!!octal(i)) update linesize(1000);/**linesize(1000) temp for pli bug*/ /*note: following loop works for both TKB and FTB maps, which have the header information in different order and case*/ /* repeat */ scan_map_header: read file(mapfile) into(mapline); call upcase(mapline); if index(mapline,'ODT XFR ADDRESS:') ^= 0 then odt_xfr_address = octbin( substr(mapline, index(mapline,':')+2, 6) ); else if index(mapline,'DISK BLK LIMITS:') ^= 0 then root_disk_blk_base = octbin( substr(mapline, index(mapline,':')+2, 6) ); else if index(mapline,'ADDRESS LIMITS:') ^= 0 /*note: this line not present in FTB maps*/ then user_address_limit = octbin( substr(mapline, index(mapline,':')+9, 6) ); else if index(mapline,'ROOT SEGMENT:') ^= 0 then root_segment_name = trim( substr(mapline, index(mapline,':')+2, 6) ); /* until first_char = carriage_return */ if first_char ^= carriage_return then goto scan_map_header; /* At this point odt_xfr_address will be zero if there was no xfr addr in the map file (ie the task was built without the debugger and without ODT). If task is built with ODT, we will index off the xfer address looking for the version word. We checked the area of ODT that this references, and it consists of code, whose offset and immediate words all look to be either negative or large positive values - so it's a pretty sure bet the version number won't match. */ if odt_xfr_address = 0 then goto nodeb; usertask_knlvnm_fileaddr = root_disk_blk_base*512 + unsigned(odt_xfr_address) + oxfvw; call posfile(taskfile, usertask_knlvnm_fileaddr); read file(taskfile) into (usertask_knlvnm_buffer); close file(taskfile); if usertask_knlvnm ^= knlvnm then do; /*no match - first see if built with our kernal (could have been built with ODT)*/ x = external_address('$DEB$$', external_procedure_class, any_parent); /*PLIDEBUG is in this psect*/ if x = not_found then do; nodeb: call put_skip_list('task was not built with PL/I debugger'); call put_skip_list(' - put LB:[1,1]PLIDEBUG/DA in your TKB command file'); call put_skip_list(' or /DEBUG:LB:[1,1]PLIDEBUG in your DCL LINK command'); stop; end; /* version words don't match - either the versions are actually different, or the .MAP is not current (has wrong xfer address, so we're looking at the wrong word). note that it is possible that the kernal is actually a newer version than the debug task (a new PLIDEBUG.OBJ was put in LB:[1,1] but the new DEBPLI.TSK was not installed properly) - we assume this is unlikely. */ call put_skip_list('task was built with old version of PLIDEBUG or the .MAP file is not current'); call put_skip_list(' - rebuild with map and try again'); stop; end; knlpktaddr = odt_xfr_address + opktad - 2; /*address in user task (in debug kernal) of word before send/receive packet*/ end;