! ! module PATDEB (ident = 'X2-001' %require ('PATSWITCH_REQ') ) = begin ! ! COPYRIGHT (c) 1982 BY ! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. ! ! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED ! ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE ! INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER ! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY ! OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY ! TRANSFERRED. ! ! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE ! AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT ! CORPORATION. ! ! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. ! !++ ! FACILITY: PAT Parser ! ! ABSTRACT: ! ! PATDEB.BLI is the parser debugger. ! ! ENVIRONMENT: VAX/VMS user mode ! ! AUTHOR: C. Mitchell, CREATION DATE: 25-Feb-80 ! ! MODIFIED BY: ! ! Charlie Mitchell, 29-Oct-1981 : VERSION X1-001 ! 001 - Use PATDATA. !-- ! ! INCLUDE FILES: ! require 'PATPROLOG_REQ'; ! BLISS extensions (for parser) library 'PATDEB_LIB'; library 'PATDATA_LIB'; ! PAT interface library 'PAT_LANGSP_LIBRARY'; ! Language Specific functions library 'PATPARSER_LIB'; ! Parser driver library 'DEB_LIB'; ! Debugging library 'PATTOKEN_LIB'; ! for PAT$TOKEN_CURRENT_PTR require 'VMS_REQ'; ! VMS interface %if PATBLSEXT_DEBUGGING %then ! ! TABLE OF CONTENTS OF INTERNAL ROUTINES: ! forward routine HELP : novalue, SET_BREAK : novalue, SHOW_STATUS : novalue, SRCH : novalue, UP_CASE : novalue, PAT$DEB : novalue; ! ! MACROS: ! macro TERM_TXT (TOKEN_NUM) = begin local P : ref SD_STR; P = PAT$DATA_SYMBOL_TEXT (TOKEN_NUM); .P [SD_TEXT] end %; macro TERM_LEN (TOKEN_NUM) = begin local P : ref SD_STR; P = PAT$DATA_SYMBOL_TEXT (TOKEN_NUM); .P [SD_LENGTH] end %; macro ACT_TXT (ACTION_NUM) = begin local P : ref SD_STR; P = PAT$DATA_SEMACT_TEXT (ACTION_NUM); .P [SD_TEXT] end %; macro ACT_LEN (ACTION_NUM) = begin local P : ref SD_STR; P = PAT$DATA_SEMACT_TEXT (ACTION_NUM); .P [SD_LENGTH] end %; macro CUR_TKN_TXT = begin local P : ref SD_STR; if LS_IS_NON_TERM (LS_LEX_TERM (PAT$TOKEN_CURRENT_PTR)) then begin P = LS_LEX_TEXT (PAT$TOKEN_CURRENT_PTR); .P [SD_TEXT] end else TERM_TXT (LS_LEX_TERM (PAT$TOKEN_CURRENT_PTR)) end %; macro CUR_TKN_LEN = begin local P : ref SD_STR; if LS_IS_NON_TERM (LS_LEX_TERM (PAT$TOKEN_CURRENT_PTR)) then begin P = LS_LEX_TEXT (PAT$TOKEN_CURRENT_PTR); .P [SD_LENGTH] end else TERM_LEN (LS_LEX_TERM (PAT$TOKEN_CURRENT_PTR)) end %; macro CUR_LINENUM = begin LS_LEX_LINE_NUMBER (LS_LEX_LOCATOR (PAT$TOKEN_CURRENT_PTR)) end %; ! ! EQUATED SYMBOLS: ! literal CMD_NULL = 0, CMD_SET = 1, CMD_CANCEL = 2, CMD_GO = 3, CMD_HELP = 4, CMD_DEBUG = 5, CMD_EXIT = 6, CMD_SHOW = 7, ! CMD_LAST = 7; literal BOPT_NAME = 0, BOPT_LINE = 1, BOPT_ALL = 2, BOPT_STATE = 3, BOPT_INPUT = 4, ! BOPT_LAST = 4; literal SRCH_SHOW = 0, SRCH_SET_TRC = 1, SRCH_SET_BRK = 2, SRCH_CAN_TRC = 3, SRCH_CAN_BRK = 4, SRCH_SHOW_ALL = 5, ! SRCH_LAST = 5; bind SPACES = uplit byte( rep 133 of byte (%c' ')); ! ! OWN STORAGE: ! own PAT$DEB_WAS_CALLED : initial (FALSE); ! Set true when PAT$DEB has been called own BRK_REDUCT_VEC : bitvector [PAT$DATA_MAX_TOKEN + 1], ! indexed by token number TRC_REDUCT_VEC : bitvector [PAT$DATA_MAX_TOKEN + 1], ! indexed by token number BRK_SEMACT_VEC : bitvector [PAT$DATA_MAX_SEMACT + 1], ! indexed by action number TRC_SEMACT_VEC : bitvector [PAT$DATA_MAX_SEMACT + 1]; ! indexed by action number own TRACE_ALL_F : initial (FALSE), ! Trace everything not being ignored BREAK_ALL_F : initial (FALSE); ! Break on all reductions own BRK_STATE : initial (-1), ! State index to break on BRK_TKN_F : initial (FALSE), ! Break on input indicated in BRK_TKN_TXT BRK_TKN_WILD_F, ! Wildcard flag for input text BRK_TKN_TXT : vector [132, byte], ! Input text to break on BRK_TKN_LEN, ! Length of input to break on BRK_LINE_F : initial (FALSE), ! Break on input line indicated in BRK_LINENUM BRK_LINENUM, ! Break on this line SAVED_LINENUM : initial (-1); global routine PAT$DEB_TOKEN (ACTUAL_PARSE) : novalue = begin local BREAK_TOKEN_F, BREAK_LINE_F; if not .PAT$DEB_WAS_CALLED then return; BREAK_TOKEN_F = FALSE; BREAK_LINE_F = FALSE; !+ ! Check if this is a new line. If so, check if a breakpoint ! is set on this line. !- if CUR_LINENUM neq .SAVED_LINENUM then begin SAVED_LINENUM = CUR_LINENUM; if .BRK_LINE_F and (CUR_LINENUM eql .BRK_LINENUM) then BREAK_LINE_F = TRUE; end; !+ ! Check if should break on this token !- if .BRK_TKN_F then if ch$eql (.BRK_TKN_LEN, BRK_TKN_TXT, CUR_TKN_LEN, CUR_TKN_TXT) then BREAK_TOKEN_F = TRUE; !+ ! Trace and break if appropriate !- if .BREAK_TOKEN_F or .BREAK_LINE_F or .TRACE_ALL_F or .BREAK_ALL_F then begin PUT_ASCII (CUR_TKN_LEN, CUR_TKN_TXT); if not .ACTUAL_PARSE then PUT_MSG (' parse-ahead'); PUT_EOL (); end; if .BREAK_TOKEN_F then begin PUT_MSG ('Break at input token '); PUT_ASCII (CUR_TKN_LEN, CUR_TKN_TXT); PUT_EOL (); PAT$DEB (); end else if .BREAK_LINE_F then begin PUT_MSG ('Break at source line number '); PUT_NUMBER (.BRK_LINENUM); PUT_EOL (); PAT$DEB (); end; end; global routine PAT$DEB_STATE (CURRENT_STATE, ACTUAL_PARSE) : novalue = begin if not .PAT$DEB_WAS_CALLED then return; if .CURRENT_STATE eql .BRK_STATE then begin PUT_MSG (' State index: '); PUT_NUMBER (.CURRENT_STATE); if not .ACTUAL_PARSE then PUT_MSG (' parse-ahead'); PUT_EOL (); PUT_MSG ('Break at state index '); PUT_NUMBER (.CURRENT_STATE); PUT_EOL (); PAT$DEB (); end else if .TRACE_ALL_F or .BREAK_ALL_F then begin PUT_MSG (' State index: '); PUT_NUMBER (.CURRENT_STATE); PUT_EOL (); end; end; global routine PAT$DEB_REDUCE (TOKEN, ACTION_NUM, ACTUAL_PARSE) : novalue = begin local BREAK_REDUCT_F, BREAK_SEMACT_F, TRACE_REDUCT_F, TRACE_SEMACT_F, TRACE_STACK_F; if not .PAT$DEB_WAS_CALLED then return; !+ ! Determine if trace/break on reduction or semantics action !- BREAK_REDUCT_F = .BREAK_ALL_F or .BRK_REDUCT_VEC [.TOKEN]; TRACE_REDUCT_F = .TRACE_ALL_F or .TRC_REDUCT_VEC [.TOKEN] or .BREAK_REDUCT_F; BREAK_SEMACT_F = .BREAK_ALL_F or .BRK_SEMACT_VEC [.ACTION_NUM]; TRACE_SEMACT_F = .TRACE_ALL_F or .TRC_SEMACT_VEC [.ACTION_NUM] or .BREAK_REDUCT_F; if .TRACE_REDUCT_F then PAT$DUMP_REDUCTION (); if not .ACTUAL_PARSE then PUT_MSG_EOL(' reduction during parse-ahead'); if .TRACE_SEMACT_F and (.ACTION_NUM neq PAT_NULL) then begin PUT_MSG (' --- Action: '); PUT_STRING (PAT$DATA_SEMACT_TEXT (.ACTION_NUM)); PUT_EOL (); end; if .TRACE_REDUCT_F or .TRACE_SEMACT_F then PUT_EOL (); if .BREAK_REDUCT_F then begin PUT_MSG ('Break on reduction to '); PUT_STRING (PAT$DATA_SYMBOL_TEXT (.TOKEN)); PUT_EOL (); PAT$DEB (); end else if .BREAK_SEMACT_F then begin PUT_MSG ('Break on semactics action '); PUT_STRING (PAT$DATA_SEMACT_TEXT (.ACTION_NUM)); PUT_EOL (); PAT$DEB (); end; end; global routine PAT$DEB : novalue = begin own PROMPT : vector [2] initial (SD_VAL ('PAT$DEB>')), CMD_DESC : block [8, byte]; local STATUS; forward routine SAVE_BOPT; ! Note that the tparse macros define their own psect which cannot ! be referenced within the Ada compiler if word relative addressing ! is used for non-external references. switches addressing_mode (nonexternal = long_relative); own COMMAND, BREAK_F, CMD_STRING : block [8, byte], CMD_NUMBER, BREAK_OPT, SHOW_ALL_F, WILD_F; own TPARSE_BLOCK : block [TPA$K_LENGTH0, byte]; ! ! !+ ! The following table is used by TPARSE to parse debugger commands. !- $INIT_STATE(CMDLINE ,CMDLINEKEY); $STATE(START, ( 'SET' ,SETCAN ,,CMD_SET ,COMMAND ), ( 'SHOW' ,OPTSHO ,,CMD_SHOW ,COMMAND ), ( 'CANCEL' ,SETCAN ,,CMD_CANCEL ,COMMAND ), ( 'GO' ,DONE ,,CMD_GO ,COMMAND ), ( '?' ,DONE ,,CMD_HELP ,COMMAND ), ( 'HELP' ,DONE ,,CMD_HELP ,COMMAND ), ( 'DBG' ,DONE ,,CMD_DEBUG ,COMMAND ), ( 'DEBUG' ,DONE ,,CMD_DEBUG ,COMMAND ), ( 'EXIT' ,DONE ,,CMD_EXIT ,COMMAND ), ( TPA$_LAMBDA ,DONE ) ); $STATE(DONE, ( TPA$_BLANK ,TPA$_EXIT ), ( TPA$_EOS ,TPA$_EXIT ) ); $STATE(SETCAN, ( 'BREAKPOINT' ,BOPT ,,TRUE ,BREAK_F ), ( 'TRACEPOINT' ,BOPT ) ); $STATE(BOPT, ( 'ALL' ,DONE ,SAVE_BOPT ,, ,BOPT_ALL ), ( 'SYMBOL' ,SINPUT ,SAVE_BOPT ,, ,BOPT_NAME ), ( 'LINE' ,SNUM ,SAVE_BOPT ,, ,BOPT_LINE ), ( TPA$_DECIMAL ,DONE ,SAVE_BOPT ,,CMD_NUMBER ,BOPT_LINE ), ( 'STATE' ,SNUM ,SAVE_BOPT ,, ,BOPT_STATE ), ( 'INPUT' ,SINPUT ,SAVE_BOPT ,, ,BOPT_INPUT ) ); $STATE(SINPUT, ( TPA$_SYMBOL ,WILD , ,,CMD_STRING ) ); $STATE(SNUM, ( TPA$_DECIMAL ,DONE , ,,CMD_NUMBER ) ); $STATE(OPTSHO, ( 'ALL' ,DONE ,,TRUE ,SHOW_ALL_F ), ( 'SYMBOL' ,SINPUT ), ( TPA$_LAMBDA ,DONE ) ); $STATE(WILD, ( '*' ,DONE ,,TRUE ,WILD_F ), ( TPA$_LAMBDA ,DONE ) ); ! ! routine SAVE_BOPT = begin builtin ap; map ap : ref block [, byte]; BREAK_OPT = .ap [TPA$L_PARAM]; ! This is the parameter in the parse table return TRUE end; ! ! ! !+ ! Start of code for PAT$DEB !- if not .PAT$DEB_WAS_CALLED then begin PUT_EOL (); ! do this so don't lose the first line since IOS_COMMAND may not have been called yet PAT$DEB_WAS_CALLED = TRUE; end; TPARSE_BLOCK [TPA$V_ABBRFM] = TRUE; ! Allow abbreviations and match the first ! eligible transition if ambiguous while 1 do begin COMMAND = 0; BREAK_F = FALSE; CMD_NUMBER = 1; CMD_STRING [DSC$W_LENGTH] = 0; CMD_STRING [DSC$A_POINTER] = 0; BREAK_OPT = 0; SHOW_ALL_F = FALSE; WILD_F = FALSE; ! CMD_DESC [DSC$B_CLASS] = DSC$K_CLASS_D; CMD_DESC [DSC$W_LENGTH] = 0; CMD_DESC [DSC$A_POINTER] = 0; LIB$GET_INPUT (CMD_DESC, PROMPT); UP_CASE (.CMD_DESC [DSC$W_LENGTH], .CMD_DESC [DSC$A_POINTER]); TPARSE_BLOCK [TPA$L_COUNT] = TPA$K_COUNT0; TPARSE_BLOCK [TPA$L_STRINGCNT] = .CMD_DESC [DSC$W_LENGTH]; TPARSE_BLOCK [TPA$L_STRINGPTR] = .CMD_DESC [DSC$A_POINTER]; STATUS = LIB$TPARSE (TPARSE_BLOCK, CMDLINE, CMDLINEKEY); if .STATUS neq SS$_NORMAL then begin PUT_MSG_EOL ('Parse error in command. Please try again.'); end else begin case .COMMAND from 0 to CMD_LAST of set [CMD_NULL] : ; [CMD_SET] : SET_BREAK (TRUE, .BREAK_F, .BREAK_OPT, .WILD_F, .CMD_STRING [DSC$W_LENGTH], .CMD_STRING [DSC$A_POINTER], .CMD_NUMBER); [CMD_CANCEL] : SET_BREAK (FALSE, .BREAK_F, .BREAK_OPT, .WILD_F, .CMD_STRING [DSC$W_LENGTH], .CMD_STRING [DSC$A_POINTER], .CMD_NUMBER); [CMD_GO] : return; [CMD_HELP] : HELP (); [CMD_DEBUG] : LIB$SIGNAL (SS$_DEBUG); [CMD_EXIT] : $EXIT (code = SS$_NORMAL); [CMD_SHOW] : SHOW_STATUS (.SHOW_ALL_F, .WILD_F, .CMD_STRING [DSC$W_LENGTH], .CMD_STRING [DSC$A_POINTER]); [inrange, outrange] : DEB_ASSERT (FALSE, 'Case error in PAT$DEB'); tes; end; end; end; routine HELP : novalue = begin macro MSGEOL = %quote PUT_MSG_EOL %; ! ! ! PUT_EOL(); MSGEOL('PAT$DEB commands follow. Commands can be abbreviated freely with '); MSGEOL('exception of set and show. ("s" is the abbrev. for "set") '); PUT_EOL(); MSGEOL('? - gives this message '); MSGEOL('help - gives this message '); PUT_EOL(); MSGEOL('set breakpoint - one of the following'); MSGEOL(' all - for all reductions '); MSGEOL(' symbol NAME [*] - at semantics action or reduction'); MSGEOL(' to non-terminal specified by NAME '); MSGEOL(' The optional "*" indicates wildcarding.'); MSGEOL(' [line] INTEGER - at source line number '); MSGEOL(' input NAME [*] - at source input NAME'); MSGEOL(' state INTEGER - at state table index '); PUT_EOL(); MSGEOL('set trace and cancel break/trace are similar to set break.'); PUT_EOL(); MSGEOL('show - show status '); MSGEOL('show all - show status and all non-terminals'); MSGEOL(' and semantics action symbols'); MSGEOL('show symbol NAME [*] - show status semactics actions and'); MSGEOL(' non-terminals specified by NAME'); PUT_EOL(); MSGEOL('go - continue '); MSGEOL('exit - all done '); MSGEOL('debug - enter DEBUG-32 '); MSGEOL('dbg - enter DEBUG-32 '); end; ! ! routine SET_BREAK (SET_F, BREAK_F, BREAK_OPT, WILD_F, LEN, ADDR, CMD_NUMBER) : novalue = !++ ! FUNCTIONAL DESCRIPTION: ! ! SET_BREAK sets (and cancels) tracepoints and breakpoints ! ! FORMAL PARAMETERS: ! ! SET_F - Set if true; cancel if false. ! ! BREAK_F - Set/cancel break if true, trace if false. ! ! BREAK_OPT - Option specified in command. ! ! WILD_F - True if wildcarding used for symbol in command. ! ! LEN - Length of symbol in command (if any). ! ! ADDR - Addr. of text of symbol in command. ! ! CMD_NUMBER - Number typed in command (if any). ! ! IMPLICIT INPUTS: ! ! NONE ! ! IMPLICIT OUTPUTS: ! ! NONE ! ! ROUTINE VALUE: ! ! NONE ! ! SIDE EFFECTS: ! ! NONE ! !-- begin case .BREAK_OPT from 0 to BOPT_LAST of set [BOPT_INPUT] : begin if .BREAK_F then if .SET_F then begin if .BRK_TKN_F then begin PUT_MSG (' Cancelled previous breakpoint for input: '); PUT_ASCII (.BRK_TKN_LEN, BRK_TKN_TXT); PUT_EOL (); end; BRK_TKN_F = TRUE; BRK_TKN_WILD_F = .WILD_F; BRK_TKN_LEN = .LEN; ch$move (.LEN, .ADDR, BRK_TKN_TXT); PUT_MSG (' Breakpoint set for source input: '); PUT_ASCII (.BRK_TKN_LEN, BRK_TKN_TXT); if .BRK_TKN_WILD_F then PUT_MSG ('*'); PUT_EOL (); end else begin PUT_MSG (' Cancelled previous breakpoint for input: '); PUT_ASCII (.BRK_TKN_LEN, BRK_TKN_TXT); PUT_EOL (); end else PUT_MSG_EOL ('Tracepoints not supported for input tokens'); end; [BOPT_NAME] : if .SET_F then ! set if .BREAK_F then SRCH (SRCH_SET_BRK, .WILD_F, .LEN, .ADDR) else SRCH (SRCH_SET_TRC, .WILD_F, .LEN, .ADDR) else ! cancel if .BREAK_F then SRCH (SRCH_CAN_BRK, .WILD_F, .LEN, .ADDR) else SRCH (SRCH_CAN_TRC, .WILD_F, .LEN, .ADDR); [BOPT_LINE] : if .BREAK_F then if .SET_F then begin if .BRK_LINE_F then begin PUT_MSG (' Cancelled breakpoint for line number '); PUT_NUMBER (.BRK_LINENUM); PUT_EOL (); end; BRK_LINE_F = TRUE; BRK_LINENUM = .CMD_NUMBER; PUT_MSG (' Breakpoint set for line number '); PUT_NUMBER (.BRK_LINENUM); PUT_EOL (); end else begin PUT_MSG_EOL ('Trace points not supported for source line numbers'); end; [BOPT_ALL] : if .SET_F then ! set if .BREAK_F then BREAK_ALL_F = TRUE else TRACE_ALL_F = TRUE else ! cancel if .BREAK_F then begin BREAK_ALL_F = FALSE; incr I from 0 to PAT$DATA_MAX_TOKEN do BRK_REDUCT_VEC [.I] = FALSE; incr I from 0 to PAT$DATA_MAX_SEMACT do BRK_SEMACT_VEC [.I] = FALSE; end else begin BREAK_ALL_F = FALSE; incr I from 0 to PAT$DATA_MAX_TOKEN do TRC_REDUCT_VEC [.I] = FALSE; incr I from 0 to PAT$DATA_MAX_SEMACT do TRC_SEMACT_VEC [.I] = FALSE; end; [BOPT_STATE] : if .BREAK_F then if .SET_F then begin if .BRK_STATE geq 0 then begin PUT_MSG (' Cancelled breakpoint for state index number '); PUT_NUMBER (.BRK_STATE); PUT_EOL (); end; BRK_STATE = .CMD_NUMBER; PUT_MSG (' Breakpoint set for state index number '); PUT_NUMBER (.BRK_STATE); PUT_EOL (); end else begin BRK_STATE = -1; PUT_MSG (' Cancelled breakpoint for line number '); PUT_NUMBER (.BRK_LINENUM); PUT_EOL (); end else begin PUT_MSG_EOL ('Trace points not supported for states'); end; [inrange, outrange] : DEB_ASSERT (FALSE, 'Case error in SET_BREAK'); tes; end; routine SHOW_STATUS (SHOW_ALL_F, WILD_F, LEN, ADDR) : novalue = begin PUT_EOL (); if .BREAK_ALL_F then PUT_MSG_EOL (' BREAK ALL') else PUT_MSG_EOL (' no BREAK ALL'); if .TRACE_ALL_F then PUT_MSG_EOL (' TRACE ALL') else PUT_MSG_EOL (' no TRACE ALL'); if .BRK_STATE geq 0 then begin PUT_MSG (' Breakpoint set at state index number '); PUT_NUMBER (.BRK_STATE); PUT_EOL (); end else PUT_MSG_EOL (' State index number breakpoint not set'); if .BRK_TKN_F then begin PUT_MSG (' Breakpoint set for source input: '); PUT_ASCII (.BRK_TKN_LEN, BRK_TKN_TXT); PUT_EOL (); end else PUT_MSG_EOL (' Source input breakpoint not set'); if .BRK_LINE_F then begin PUT_MSG (' Breakpoint set for source line number '); PUT_NUMBER (.BRK_LINENUM); PUT_EOL (); end else PUT_MSG_EOL (' Source line number breakpoint not set'); if .SHOW_ALL_F then SRCH (SRCH_SHOW_ALL, .WILD_F, .LEN, .ADDR) else SRCH (SRCH_SHOW, .WILD_F, .LEN, .ADDR) ; end; routine SRCH (SRCH_TYPE, WILD_F, LEN, ADDR) : novalue = begin local MATCH_F, FIRST_NONTRM_F, FIRST_SEMACT_F, FILL_LEN; literal MAX_SYM_LEN = 30; FIRST_NONTRM_F = TRUE; incr I from 0 to PAT$DATA_MAX_TOKEN do begin MATCH_F = FALSE; if .SRCH_TYPE eql SRCH_SHOW_ALL then begin if LS_IS_NON_TERM (.I) then MATCH_F = TRUE end else if .LEN leq 0 then begin if (.SRCH_TYPE eql SRCH_SHOW) and (.BRK_REDUCT_VEC [.I] or .TRC_REDUCT_VEC [.I]) then if LS_IS_NON_TERM (.I) then MATCH_F = TRUE end else if LS_IS_NON_TERM (.I) then if .WILD_F then MATCH_F = ch$eql (.LEN, .ADDR, .LEN, TERM_TXT (.I)) else MATCH_F = ch$eql (.LEN, .ADDR, TERM_LEN (.I), TERM_TXT (.I)); if .MATCH_F then begin if .FIRST_NONTRM_F then begin FIRST_NONTRM_F = FALSE; PUT_EOL (); PUT_MSG_EOL (' Non-terminal status:') end; case .SRCH_TYPE from 0 to SRCH_LAST of set [SRCH_SHOW, SRCH_SHOW_ALL] : ; [SRCH_SET_TRC] : TRC_REDUCT_VEC [.I] = TRUE; [SRCH_SET_BRK] : BRK_REDUCT_VEC [.I] = TRUE; [SRCH_CAN_TRC] : TRC_REDUCT_VEC [.I] = FALSE; [SRCH_CAN_BRK] : BRK_REDUCT_VEC [.I] = FALSE; tes; PUT_MSG (' '); PUT_STRING (PAT$DATA_SYMBOL_TEXT (.I)); FILL_LEN = MAX_SYM_LEN - TERM_LEN (.I); if .FILL_LEN gtr 0 then PUT_ASCII (.FILL_LEN, SPACES); if .BRK_REDUCT_VEC [.I] then PUT_MSG (' break ') else PUT_MSG (' no break '); if .TRC_REDUCT_VEC [.I] then PUT_MSG_EOL ('trace') else PUT_MSG_EOL ('no trace'); end; end; FIRST_SEMACT_F = TRUE; incr I from 0 to PAT$DATA_MAX_SEMACT do begin MATCH_F = FALSE; if .SRCH_TYPE eql SRCH_SHOW_ALL then MATCH_F = TRUE else if .LEN leq 0 then begin if (.SRCH_TYPE eql SRCH_SHOW) and (.BRK_SEMACT_VEC [.I] or .TRC_SEMACT_VEC [.I]) then MATCH_F = TRUE end else if .WILD_F then MATCH_F = ch$eql (.LEN, .ADDR, .LEN, ACT_TXT (.I)) else MATCH_F = ch$eql (.LEN, .ADDR, ACT_LEN (.I), ACT_TXT (.I)); if .MATCH_F then begin if .FIRST_SEMACT_F then begin FIRST_SEMACT_F = FALSE; PUT_EOL (); PUT_MSG_EOL (' Semantics action status:') end; case .SRCH_TYPE from 0 to SRCH_LAST of set [SRCH_SHOW, SRCH_SHOW_ALL] : ; [SRCH_SET_TRC] : TRC_SEMACT_VEC [.I] = TRUE; [SRCH_SET_BRK] : BRK_SEMACT_VEC [.I] = TRUE; [SRCH_CAN_TRC] : TRC_SEMACT_VEC [.I] = FALSE; [SRCH_CAN_BRK] : BRK_SEMACT_VEC [.I] = FALSE; tes; PUT_MSG (' '); PUT_STRING (PAT$DATA_SEMACT_TEXT (.I)); FILL_LEN = MAX_SYM_LEN - ACT_LEN (.I); if .FILL_LEN gtr 0 then PUT_ASCII (.FILL_LEN, SPACES); if .BRK_SEMACT_VEC [.I] then PUT_MSG (' break ') else PUT_MSG (' no break '); if .TRC_SEMACT_VEC [.I] then PUT_MSG_EOL ('trace') else PUT_MSG_EOL ('no trace'); end; end; if (.LEN gtr 0) and .FIRST_NONTRM_F and .FIRST_SEMACT_F then if .WILD_F then begin PUT_EOL (); PUT_MSG_EOL ('No non-terminal or semantics action symbols starting with'); PUT_MSG (' '); PUT_ASCII (.LEN, .ADDR); PUT_MSG_EOL (' were found'); end else begin PUT_EOL (); PUT_ASCII (.LEN, .ADDR); PUT_MSG_EOL (' is not a non-terminal or semantics action'); end; end; routine UP_CASE (LEN, STRING_P) : novalue = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine converts a string to upper case. ! ! FORMAL PARAMETERS: ! ! LEN - Length of string ! ! STRING_P - Pointer to string ! ! IMPLICIT INPUTS: ! ! NONE ! ! IMPLICIT OUTPUTS: ! ! NONE ! ! ROUTINE VALUE: ! ! NONE ! ! SIDE EFFECTS: ! ! NONE ! !-- begin map STRING_P : ref vector [, byte]; incr I from 0 to .LEN - 1 do if (.STRING_P [.I] geq %c'a') and (.STRING_P [.I] leq %c'z') then STRING_P [.I] = .STRING_P [.I] - %x'20'; end; %else 0 ! Nothing from this module if not debugging %fi end !End of module eludom