/* error reporter for PL/I symbolic debugger, does not return to caller */ error: procedure(msg); dcl msg char(*); %include 'putdef.pli'; %include 'scandef.pli'; %include 'workdef.pli'; %include 'initdef.pli'; dcl ttoken char(3) varying static; /*only need big enough to tell DO from anything else, static for efficiency*/ /**************************************************************************************************************/ call warning(msg); if in_include ! (scan_state_nesting_level ^= 0) /*non-interactive (in do-group, debprocedure, or include file) */ then do; /* - skip the command*/ if nextp <= length(commandline) then do; nextp = startp; /* repeat */ find_next_command: do while(nexttoken(ttoken) ^= punctuation_type); if in_set_break & (ttoken = 'DO') /*if in a SET BREAK, must skip entire DO group*/ then do; debprocedure_define_level = debprocedure_define_level+1; /* exit repeat loop */ goto found_next_command; end; end; /* end until ttoken = ';' */ if ttoken ^= ';' then goto find_next_command; found_next_command: startp = nextp; end; end; else do; /*interactive - if defining do-group/debprocedure, let user retry*/ if debprocedure_define_level ^= 0 then do; call workpos(work_debprocedure_line_pos, put_workp); call put_skip_list('Re-enter line in DO-group or procedure (control-W restores the line for editing)'); last_commandline = substr(commandline, debprocedure_startp); /*have it restore the right thing*/ /*this will normally be the entire line, but if first line of do-group or debprocedure, must only contain remainder of line after DO or PROCEDURE keyword*/ /*note. if the error is in a nested DO line (in a DO of a SET BREAK that is also in a DO), then debprocedure_define_level will be off (incremented each scan) - user will have to type an extra END. oh well, we try to be nice, but you can't expect us to be sweet.*/ end; nextp = ignore_rest_of_line; /*force rest of line to be skipped*/ end; if initializing then signal finish; /*errors in the initialization sequence are fatal*/ else signal condition(endcmd); /*return directly to do_command*/ end /*error*/; /* warning reporter for PL/I symbolic debugger, returns to caller */ warning: procedure(msg); dcl msg char(*); %include 'putdef.pli'; %include 'scandef.pli'; %include 'typestr.inc'; dcl i fixed bin(15); /**************************************************************************************************************/ call put_skip_list; call type_string(commandline,no_double_quotes); /*make control chars visible - they could be the problem*/ /*note that tabs are control chars - by typing them in one character, our error pointer is not screwed up by them*/ call put_skip_list; do i = 1 to errorp-1; call put_list(' '); end; call put_list('^'); /*point to error position*/ call put_skip_list(msg); return; end /*warning*/; /* PL/I symbolic debugger procedure to type a string, showing control chars as ~ called by error, as well as EXAMINE/PUT. note: edit_command does its own squiggles. */ type_string: procedure(str, quoteswitch); %include 'putdef.pli'; dcl str char(*), quoteswitch fixed bin(1), c char, i fixed bin(15); dcl printable_char entry(char(1)) returns(char(7) varying); /**************************************************************************************************************/ do i = 1 to length(str); c = substr(str,i,1); call put_list(printable_char(c)); if (c = '''') & quoteswitch then call put_list(''''); /*double quote chars*/ end; end /*type_string*/; /* procedure to recognize a control character in a print line and display it as a '~' or special VT100 graphics character (if one exists) */ printable_char:procedure(c) returns(char(7) varying); %include 'scandef.pli'; dcl iand entry(fixed bin(15), fixed bin(15)) returns(fixed bin(15)); dcl 1 graphics_mode static, /* escape sequence to enter graphics mode */ 2 a fixed bin(7) initial('033'b3), 2 b char(2) initial('(0'); dcl 1 USASCII_mode static, /* escape squence to enter normal ascii mode */ 2 a fixed bin(7) initial('033'b3), 2 b char(2) initial('(B'); dcl c char,charb fixed bin(7) based(charp);charp = addr(c); dcl char7v char(7) varying, i fixed bin(15), source_control_char(5) fixed bin(7) static initial('011'B3,'012'B3,'013'B3,'014'B3,'015'B3), graphics_control_char(5) fixed bin(7) static initial('142'B3,'145'B3,'151'B3,'143'B3,'144'B3); /**************************************************************************************************************/ charb = iand(charb, '7F'B4); if (charb<'40'B3 /*blank*/ ! charb='177'B3 /*rubout*/) then do;/*replace control characters with printable characters*/ char7v = ''; if VT100 /*display return, linefeed, horizontal tab, vertical tab, or formfeed with VT100 graphics character*/ then do i = 1 to hbound(source_control_char,1); if charb = source_control_char(i) then char7v = string(graphics_mode)!!string(graphics_control_char(i)) !!string(USASCII_mode); end; if char7v = '' then char7v = '~'; /*if control char does not have a VT100 graphics char display a '~' */ end; else char7v = c; /*if not a control character no change is needed*/ return(char7v); end /*printable_char*/;