Google
 

Trailing-Edge - PDP-10 Archives - BB-H138F-BM_1988 - 7-sources/diulan.bli
There are 4 other files named diulan.bli in the archive. Click here to see a list.
MODULE DIULAN (ident = '253'
		%REQUIRE ('DIUPATSWITCH')
		) =
begin
!++
!	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1986.
!	ALL RIGHTS RESERVED.
!
!	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 THAT IS NOT SUPPLIED BY DIGITAL.
!
! FACILITY:	Pat Parser
!
! ABSTRACT:
!
!	PATLANGSP.REQ defines the interface between the user of the
!	PAT Parser and the language independent portion of the parser.
!	PATLANGSP.REQ and .BLI are provided with the PAT parser package
!	and provide an example of a particular implementation of the
!	interface specification.
!
!	Nothing in this module is referenced directly by the language
!	independent portion of the parser.
!
!	THIS FILE MUST BE ALTERED TO USE WITH OTHER COMPILERS !
!
! ENVIRONMENT:  VAX/VMS user mode
!
! AUTHOR:  H. Alcabes, CREATION DATE:  3-Dec-80
!
! MODIFIED BY:
!
! 	Charlie Mitchell, 02-Nov-1981 : VERSION X2-001
! 001 -	Modify to use new PATDATA and remove direct references from
!	parser.
!
! 002 - Remove VMS dependencies.  25-May-84 C. Richardson
!
!  64	Make PAT PARSER signal parsing errors correctly.  Change TEXT_BUFn
!       to TEXT_nBUF in PATPAR.BLI so that DDT can distinguish the symbols.
!	Sandy Clemens  15-Jan-86
!
!  253  Rename file to DIULAN.
!       Gregory A. Scott 1-Jul-86
!
!--
! INCLUDE FILES:

require 'DIUPATPROLOG';                 ! 

%BLISS36 (
library 'FAO';
UNDECLARE TRUE, FALSE;
library 'DIU';
)

library 'BLI:XPORT';

library 'DIUPATLANGSP';

library 'DIUPATDATA';

library 'DIUDEB';                       ! Debug routines
!
! TABLE OF CONTENTS:

! This file is divided into the same six sections as PATLANGSP.REQ.

! Section 1.  Interface to lexical analyzer and lexical tokens.

forward routine
    PAT$LSLOCAL_SAVE_TOKEN : novalue,		! Save a lexical token
    PAT$LSLOCAL_RETURN_SAVED_TOKEN,		! Return the saved token
    PAT$LSLOCAL_OUTPUT_TOKEN,			! Return string descriptor containing token description
    PAT$LSLOCAL_LOC_TEXT;			! Return text for locator

%if PATBLSEXT_DEBUGGING
%then
forward routine
    PAT$LSLOCAL_DUMP_TOK : novalue;		! Dump particular lexical token
%fi

! Section 2.  Terminal and non-terminal symbol interpretation.

macro									! 002
    sd_base = 0, 0, 0, 0 %;						! 002

forward routine
    PAT$LSLOCAL_SYMBOL_CLASS,			! Return symbol class
    PAT$LSLOCAL_IS_NON_TERM,			! Check for a non-terminal
    PAT$LSLOCAL_IS_RESERVED_WORD,		! Check for a reserved word
    PAT$LSLOCAL_OUTPUT_TERM;			! Return string descriptor containing token type

! Section 3.  Action routine interface - no routines in this category

! Section 4.  Error message interface (local and scope recovery) - no
!	      routines in this category

! Section 5.  Error message interface (global recovery)

forward routine
    PAT$LSLOCAL_EXPECTED_SYMBOL : novalue,	! Add expected symbol to tables
    PAT$LSLOCAL_GLOBAL_ERROR_MSG : novalue;	! Print global error message

! Section 6.  Other definitions (misc. utility routines)

forward routine
    APPEND_TO_TEXT : novalue,			! Append a contents of a string descriptor to TEXT_SD
    DOWN_CASE : novalue;			! Create a lowercase of a string descriptor
! MACROS:

! Define a macro for the token structure to minimize
! use of TKN_*.

macro
    LSLOCAL_TKN_STR =
	TKN_STR %;				! Token structure

! See text buffers below and routine APPEND_TO_TEXT

macro
    APPEND_TO_TEXTM (BUFNUM, SSTRING) =
	begin								! 002
	%if %isstring (SSTRING)						! 002
	%then								! 002
	    local s: $str_descriptor (string=sstring);			! 002
	%else								! 002
	    bind s = sstring;						! 002
	%fi								! 002
	APPEND_TO_TEXT (BUFNUM, S);					! 002
	end								! 002
    %;

! See text buffers below and routine APPEND_TO_TEXT

macro
    CLEAR_TEXTM (BUFNUM) =
	begin
	TEXT_BUF_FULL [BUFNUM] = FALSE;
	TEXT_SD [BUFNUM, STR$H_LENGTH] = 0				! 002
	end
    %;
! OWN STORAGE:

! Text buffers managed by routine APPEND_TO_TEXT and
! macros APPEND_TO_TEXTM and CLEAR_TEXTM.  Three text buffers
! are used to hold text prior to an actual call to report the
! error.

literal
    TEXT_BUF0_SIZE = 128,
    TEXT_BUF1_SIZE = 128,
    TEXT_BUF2_SIZE = 128;

own
    TEXT_BUF_SIZE : vector [3] preset (
	[0] = TEXT_BUF0_SIZE,
	[1] = TEXT_BUF1_SIZE,
	[2] = TEXT_BUF2_SIZE),
    TEXT_BUF_FULL : vector [3 %BLISS32 (, byte)];			! 002

GLOBAL
    TEXT_0BUF : vector [ch$allocation (TEXT_BUF0_SIZE)],		! 002
    TEXT_1BUF : vector [ch$allocation (TEXT_BUF1_SIZE)],		! 002
    TEXT_2BUF : vector [ch$allocation (TEXT_BUF2_SIZE)];		! 002

own
    TEXT_SD : blockvector [3, STR$K_F_BLN]				! 002
	field (STR$B_CLASS, STR$B_DTYPE, STR$H_LENGTH, STR$A_POINTER)	! 002
	preset (							! 002
	[0, STR$A_POINTER] = ch$ptr (TEXT_0BUF),			! 002
	[1, STR$A_POINTER] = ch$ptr (TEXT_1BUF),			! 002
	[2, STR$A_POINTER] = ch$ptr (TEXT_2BUF));			! 002

! Temporary text buffer for down casing reserved words.

own
    TEMP_BUF : vector [ch$allocation (132)],				! 002
    TEMP_TEXT : $STR_DESCRIPTOR (string = (132, ch$ptr (TEMP_BUF)));	! 002

! Storage used by PAT$LSLOCAL_SAVE_TOKEN to save a lexical token.

own
    SAVED_TOKEN : LSLOCAL_TKN_STR;
! EQUATED SYMBOLS

! Literals representing possible symbol classes

ENUMERATION ('SYMCLASS', 1, 			!
    SYMCLASS_RW, 				! Reserved word
    SYMCLASS_SPECIALCH, 			! Special character
    SYMCLASS_PATH_NAME,				! CDD path name
    SYMCLASS_CDD_NAME,				! CDD name
    SYMCLASS_DESCR_TEXT,			! DESCRIPTION text
    SYMCLASS_STRING, 				! Character string
    SYMCLASS_NUMBER, 				! Number (integer or real)
    SYMCLASS_EOF, 				! End of file
    SYMCLASS_NONTERM);				! Non-terminal
!				Section 1

! Interface to lexical analyer and lexical tokens:
global routine PAT$LSLOCAL_SAVE_TOKEN (TOKEN_PTR) : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
!	See LS_SAVE_TOKEN macro in PATLANGSP.REQ.
!	LS_SAVE_TOKEN is used whenever an error is detected at the
!	very start of error recovery with a pointer to a
!	lexical token.  (The current token when the error was detected.)
!	LS_SAVE_TOKEN must save the token (including auxiliary information
!	that is associated with the token).  This is necessary because
!	the global recovery algorithm can skip an arbitrarily large number
!	of tokens (more than fit in the ring buffer required by
!	LS_GET_LEX_TOKEN).
!
!	After global error recovery has been completed but before an error
!	message is issued, LS_RETURN_SAVED_TOKEN is called to return a
!	pointer to the save token.  The saved token is then used in
!	constructing the error message:
!
!		Found <description-of-saved-token> when expecting ...
!
!	Two consecutive calls are never made to LS_SAVE_TOKEN without an
!	intervening call to LS_RETURN_SAVED_TOKEN.
!
! FORMAL PARAMETERS:
!
!	TOKEN_PTR	Pointer to token to save.
!
! IMPLICIT INPUTS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	SAVED_TOKEN	gets saved token.
!
! ROUTINE VALUE:
!
!	None.
!
! SIDE EFFECTS:
!
!	None.
!
!--
    begin
    map
	token_ptr: ref lslocal_tkn_str;

    saved_token [tkn_term]		= .token_ptr [tkn_term];
    saved_token [tkn_locator]		= .token_ptr [tkn_locator];
    saved_token [tkn_text]		= .token_ptr [tkn_text];
    saved_token [tkn_clean_text]	= .token_ptr [tkn_clean_text];
    saved_token [tkn_comments]		= .token_ptr [tkn_comments];
    saved_token [tkn_intvalue]		= .token_ptr [tkn_intvalue];
    saved_token [tkn_realvalue]		= .token_ptr [tkn_realvalue];
    saved_token [tkn_start_line]	= .token_ptr [tkn_start_line];
    saved_token [tkn_synthetic]		= .token_ptr [tkn_synthetic];

    end;
global routine PAT$LSLOCAL_RETURN_SAVED_TOKEN (TOKEN_PTR) =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	See LS_RETURN_SAVED_TOKEN macro in PATLANGSP.REQ.
!	LS_RETURN_SAVED_TOKEN returns the token saved by LS_SAVE_TOKEN.
!
! FORMAL PARAMETERS:
!
!	TOKEN_PTR	(not used)
!
! IMPLICIT INPUTS:
!
!	SAVED_TOKEN	The saved token.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! ROUTINE VALUE:
!
!	Address of SAVED_TOKEN.
!
! SIDE EFFECTS:
!
!	None.
!
!--

    begin
    return SAVED_TOKEN
    end;
global routine PAT$LSLOCAL_OUTPUT_TOKEN (TOKEN_PTR, BUFNUM) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	PAT$LSLOCAL_OUTPUT_TOKEN stores text describing a lexical token in
!	a string descriptor and returns that string descriptor.
!
! FORMAL PARAMETERS:
!
!	TOKEN_PTR	- Pointer to a lexical token
!
!	BUFNUM		- Number of text buffer to be used
!
! IMPLICIT INPUTS:
!
!	Text buffer indexed by BUFNUM.
!
! IMPLICIT OUTPUTS:
!
!	Text buffer indexed by BUFNUM.
!
! ROUTINE VALUE:
!
!	TEXT_PTR	- Pointer to string descriptor containing description
!			  of token
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    begin

    map
	TOKEN_PTR : ref LSLOCAL_TKN_STR;

    local
	TERM_NUM;

    TERM_NUM = LS_LEX_TERM (TOKEN_PTR);
    CLEAR_TEXTM (.BUFNUM);

    selectone PAT$LSLOCAL_SYMBOL_CLASS (.TERM_NUM) of
	set

	[SYMCLASS_RW] :
	    begin
	    APPEND_TO_TEXTM (.BUFNUM, 'keyword ');
	    DOWN_CASE (PAT$DATA_SYMBOL_TEXT (.TERM_NUM), TEMP_TEXT);
	    APPEND_TO_TEXTM (.BUFNUM, '"');
	    APPEND_TO_TEXTM (.BUFNUM, TEMP_TEXT);
	    APPEND_TO_TEXTM (.BUFNUM, '"');
	    end;

	[SYMCLASS_SPECIALCH] :
	    begin
	    APPEND_TO_TEXTM (.BUFNUM, '"');
	    APPEND_TO_TEXTM (.BUFNUM, PAT$DATA_SYMBOL_TEXT (.TERM_NUM));
	    APPEND_TO_TEXTM (.BUFNUM, '"');
	    end;

	[SYMCLASS_PATH_NAME, SYMCLASS_CDD_NAME] :
	    begin
	    if PAT$LSLOCAL_SYMBOL_CLASS (.TERM_NUM) eqlu SYMCLASS_PATH_NAME
		then APPEND_TO_TEXTM (.BUFNUM, 'path-name')
		else APPEND_TO_TEXTM (.BUFNUM, 'variable-name');
	    if not LS_LEX_SYNTHETIC (TOKEN_PTR)
	    then
		begin
		APPEND_TO_TEXTM (.BUFNUM, ' ');
		APPEND_TO_TEXTM (.BUFNUM, LS_LEX_TEXT (TOKEN_PTR));
		end;
	    end;

	[SYMCLASS_NUMBER] :
	    begin
	    if .TOKEN_PTR [TKN_TERM] eqlu T_HEX_NUMBER
		then APPEND_TO_TEXTM (.BUFNUM, 'hex-number')
		else if .TOKEN_PTR [TKN_TERM] eqlu T_OCTAL_NUMBER
		    then APPEND_TO_TEXTM (.BUFNUM, 'octal-number')
		    else APPEND_TO_TEXTM (.BUFNUM, 'number');
	    if not LS_LEX_SYNTHETIC (TOKEN_PTR)
	    then
		begin
		APPEND_TO_TEXTM (.BUFNUM, ' ');
		APPEND_TO_TEXTM (.BUFNUM, LS_LEX_TEXT (TOKEN_PTR));
		end;
	    end;

	[SYMCLASS_STRING, SYMCLASS_DESCR_TEXT] :
	    begin
	    if .TOKEN_PTR [TKN_TERM] eqlu T_QUOTED_STRING
		then APPEND_TO_TEXTM (.BUFNUM, 'string-literal')
		else APPEND_TO_TEXTM (.BUFNUM, 'description');
	    if not LS_LEX_SYNTHETIC (TOKEN_PTR)
	    then
		begin
		APPEND_TO_TEXTM (.BUFNUM, ' ');
		APPEND_TO_TEXTM (.BUFNUM, LS_LEX_TEXT (TOKEN_PTR));
		end;
	    end;

	[SYMCLASS_EOF] :
	    APPEND_TO_TEXTM (.BUFNUM, 'end-of-file');

	[SYMCLASS_NONTERM] :
	    0;
	tes;

    return TEXT_SD [.BUFNUM, SD_BASE]
    end;
%if PATBLSEXT_DEBUGGING
%then

global routine PAT$LSLOCAL_DUMP_TOK (TOKEN_PTR) : novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!	PAT$LSLOCAL_DUMP_TOK outputs the lexical token pointed to by TOKEN_PTR.
!	This routine is only called by the debugging routines and only via
!	the LS_DUMP_TOK macro.
!
! FORMAL PARAMETERS:
!
!	TOKEN_PTR	- Pointer to the lexical token which is to be dumped.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    begin

    map
	TOKEN_PTR : ref LSLOCAL_TKN_STR;

    macro
	OUTPUT_TEXT =
	    PUT_STRING (LS_LEX_TEXT (TOKEN_PTR)) %;

    macro
	OUTPUT_CLEAN =
	    PUT_STRING (.TOKEN_PTR [TKN_CLEAN_TEXT]) %;

    local
	NUM;

    NUM = LS_LEX_TERM (TOKEN_PTR);
    PUT_MSG ('PAT$LSLOCAL_DUMP_TOK	');

    if not LS_LEX_SYNTHETIC (TOKEN_PTR)
    then
	begin

	selectone PAT$LSLOCAL_SYMBOL_CLASS (.NUM) of
	    set

	    [SYMCLASS_RW] :
		begin
		PUT_MSG ('Keyword:  ');
		PUT_STRING (PAT$DATA_SYMBOL_TEXT (.NUM));
		end;

	    [SYMCLASS_SPECIALCH] :
		begin
		PUT_MSG ('Special character(s):  "');
		PUT_STRING (PAT$DATA_SYMBOL_TEXT (.NUM));
		PUT_MSG ('"');
		end;

	    [SYMCLASS_PATH_NAME] :
		begin
		PUT_MSG ('Path name: ');
		OUTPUT_TEXT;
		end;

	    [SYMCLASS_CDD_NAME] :
		begin
		PUT_MSG ('CDD name: ');
		OUTPUT_TEXT;
		end;

	    [SYMCLASS_DESCR_TEXT] :
		begin
		PUT_MSG ('Description: ');
		OUTPUT_TEXT;
		end;

	    [SYMCLASS_STRING] :
		begin
		PUT_MSG ('Character string:  ');
		OUTPUT_TEXT;
		PUT_EOL ();
		end;

	    [SYMCLASS_NUMBER] :
		begin
		if .num eqlu T_HEX_NUMBER
		    then PUT_MSG ('Hex number: ')
		    else if .num eqlu T_OCTAL_NUMBER
			then PUT_MSG ('Octal number: ')
			else PUT_MSG ('Number: ');
		OUTPUT_TEXT;
		PUT_EOL ();
		if .num eqlu T_SIGNED_INTEGER or
		    .num eqlu T_UNSIGNED_INTEGER
		    then begin
			PUT_MSG ('     Base 10 value is ');
			PUT_NUMBER (.TOKEN_PTR [TKN_INTVALUE]);
			end;
		end;

	    [SYMCLASS_EOF] :
		begin
		PUT_MSG_EOL ('End of file token');
		return
		end;

	    [OTHERWISE] :
		begin
		PUT_MSG ('Invalid token.  TKN_TERM field = ');
		PUT_NUMBER (.NUM);
		end;
	    tes;

	PUT_EOL ();
	PUT_MSG ('Locator:	Line number:   ');
	PUT_NUMBER (LS_LEX_LINE_NUMBER (LS_LEX_LOCATOR (TOKEN_PTR)));
	PUT_MSG ('	Column number:   ');
	PUT_NUMBER (LS_LEX_COLUMN_NUMBER (LS_LEX_LOCATOR (TOKEN_PTR)));
	PUT_EOL ();

	if LS_LEX_START_LINE (TOKEN_PTR)
	    then PUT_MSG ('First token on text line.		')
	    else PUT_MSG ('					');

	PUT_MSG ('Comments pointer:  ');

	if .TOKEN_PTR [TKN_COMMENTS] eql NULL
	    then PUT_MSG ('NULL')
	    else PUT_HEX_LONG (.TOKEN_PTR [TKN_COMMENTS]);

	PUT_EOL ();
	end

    else 					! Synthetic token (inserted by error recovery)
	begin
	PUT_MSG ('Synthetic ');

	selectone PAT$LSLOCAL_SYMBOL_CLASS (.NUM) of
	    set

	    [SYMCLASS_RW] :
		begin
		PUT_MSG ('keyword:  ');
		PUT_STRING (PAT$DATA_SYMBOL_TEXT (.NUM));
		end;

	    [SYMCLASS_SPECIALCH] :
		begin
		PUT_MSG ('special character(s):  "');
		PUT_STRING (PAT$DATA_SYMBOL_TEXT (.NUM));
		PUT_MSG ('"');
		end;

	    [SYMCLASS_PATH_NAME] :
		PUT_MSG ('path name');

	    [SYMCLASS_CDD_NAME] :
		PUT_MSG ('CDD name');

	    [SYMCLASS_DESCR_TEXT] :
		PUT_MSG ('description');

	    [SYMCLASS_STRING] :
		PUT_MSG ('character string');

	    [SYMCLASS_NUMBER] :
		if .num eqlu T_HEX_NUMBER
		    then PUT_MSG ('hex number')
		    else if .num eqlu T_OCTAL_NUMBER
			then PUT_MSG ('octal number')
			else PUT_MSG ('number');

	    [SYMCLASS_EOF] :
		PUT_MSG_EOL ('end of file token');

	    [OTHERWISE] :
		begin
		PUT_MSG ('token.  The token type is invalid.  TKN_TERM field = ');
		PUT_NUMBER (.NUM);
		end;
	    tes;

	PUT_EOL ();
	end;

    end;

%fi
global routine PAT$LSLOCAL_LOC_TEXT (SLOC) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine converts source locator information to a text
!	string of the form:
!
!		on line 10
!
!	The text does not have leading or trailing spaces.
!
!	Static storage is used for the text string.  Thus, a call
!	to LS_LOC_TEXTM destroys the text string from the previous call
!	to LS_LOC_TEXTM.
!	Note, however, that LS_LOC_TEXTM can be used multiple times in
!	a single call to LSLOCAL_SYNTAX_ERROR_TEXTM since each string is
!	moved to a buffer.
!
! FORMAL PARAMETERS:
!
!	SLOC	- Encoded source locator.
!
! IMPLICIT INPUTS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! ROUTINE VALUE:
!
!	Address of a string descriptor for the text.
!
! SIDE EFFECTS:
!
!	None.
!
!--

    begin

%BLISS32 (								! 002
    library 'SYS$LIBRARY:STARLET';		! for FAOL
)									! 002
    literal
	MAX_LOC_LENGTH = 60;

    own
	LOC_TEXT : vector [ch$allocation (MAX_LOC_LENGTH)],		! 002
	LOC:$STR_DESCRIPTOR(string=(MAX_LOC_LENGTH, ch$ptr(LOC_TEXT))),	! 002
	CTL: $STR_DESCRIPTOR (string = 'on line !ZL');			! 002

    local
	ACTUAL,
	LINE;

    ACTUAL = 0;
    LOC [STR$H_LENGTH] = MAX_LOC_LENGTH;				! 002
    LINE = LS_LEX_LINE_NUMBER (.SLOC);
    $FAOL (CTRSTR = CTL, OUTLEN = ACTUAL, OUTBUF = LOC, PRMLST = LINE);
    LOC [STR$H_LENGTH] = .ACTUAL;					! 002
    return LOC
    end;					! End of PAT$LSLOCAL_LOC_TEXT
!				Section 2

! Macros to interpret terminal and non-terminal symbols.
global routine PAT$LSLOCAL_SYMBOL_CLASS (SYMBOL) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	PAT$LSLOCAL_SYMBOL_CLASS returns the class of a symbol (reserved word,
!	non-terminal, special character, etc.).
!
!	Note that a bitvector implementation would provide a faster and
!	more compact implementation.
!
! FORMAL PARAMETERS:
!
!	SYMBOL		- Terminal or non terminal symbol type
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	Symbol class (e.g. SYMCLASS_RW, SYMCLASS_SPECIALCH, etc.)
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    begin

    selectone .SYMBOL of
	set

	[T_ALIGNED to T_ZONED] :
	    return SYMCLASS_RW;

	[T_STAR, T_DOT, T_COLON, T_SEMICOLON] :
	    return SYMCLASS_SPECIALCH;

	[T_PATH_NAME] :
	    return SYMCLASS_PATH_NAME;

	[T_CDD_NAME] :
	    return SYMCLASS_CDD_NAME;

	[T_DESCR_TEXT] :
	    return SYMCLASS_DESCR_TEXT;

	[T_UNSIGNED_INTEGER, T_SIGNED_INTEGER, T_FIXED_POINT, T_FLOATING_POINT,
	    T_HEX_NUMBER, T_OCTAL_NUMBER] :
	    return SYMCLASS_NUMBER;

	[T_QUOTED_STRING] :
	    return SYMCLASS_STRING;

	[T_EOF] :
	    return SYMCLASS_EOF;

	[otherwise] :
	    return SYMCLASS_NONTERM;
	tes;

    end;
global routine PAT$LSLOCAL_IS_NON_TERM (SYMBOL_NUM) =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Determine if symbol is a nonterminal.
!	Called only by macro LS_IS_NON_TERM.
!
! FORMAL PARAMETERS:
!
!	SYMBOL_NUM	symbol number.
!
! IMPLICIT INPUTS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! ROUTINE VALUE:
!
!	TRUE if SYMBOL_NUM is a nonterminal, FALSE otherwise.
!
! SIDE EFFECTS:
!
!	None.
!
!--

    begin
    PAT$LSLOCAL_SYMBOL_CLASS (.SYMBOL_NUM) eql SYMCLASS_NONTERM
    end;
global routine PAT$LSLOCAL_IS_RESERVED_WORD (SYMBOL_NUM) =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Determine if symbol is a reserved word.
!	Called only by macro LSLOCAL_IS_RESERVED_WORD.
!
! FORMAL PARAMETERS:
!
!	SYMBOL_NUM	symbol number.
!
! IMPLICIT INPUTS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! ROUTINE VALUE:
!
!	TRUE if SYMBOL_NUM is a reserved word, FALSE otherwise.
!
! SIDE EFFECTS:
!
!	None.
!
!--

    begin
    PAT$LSLOCAL_SYMBOL_CLASS (.SYMBOL_NUM) eql SYMCLASS_RW
    end;
global routine PAT$LSLOCAL_OUTPUT_TERM (TERM_NUM, FULL, BUFNUM) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	PAT$LSLOCAL_OUTPUT_TERM  stores text describing a terminal symbol in
!	a string descriptor and returns that string descriptor.
!
! FORMAL PARAMETERS:
!
!	TERM_NUM	- Terminal or non-terminal number
!
!	FULL		- If TRUE return the terminal symbol
!			  and whatever additional
!			  descriptive information is desired
!			  If FALSE, return text for terminal only.
!			  For example, assume that TERM_NUM was
!			  the number of the reserved word LOOP.
!			  If TRUE, this routine might return the
!		 	  text string
!
!				reserved word "loop"
!
!			  If FALSE, it would just return
!
!				"loop"
!
!	BUFNUM		- Number of text buffer to be used
!
! IMPLICIT INPUTS:
!
!	Text buffer indexed by BUFNUM.
!
! IMPLICIT OUTPUTS:
!
!	Text buffer indexed by BUFNUM.
!
! ROUTINE VALUE:
!
!	TEXT_PTR	- Pointer to string descriptor containing description
!			  of token
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    begin
    CLEAR_TEXTM (.BUFNUM);

    selectone PAT$LSLOCAL_SYMBOL_CLASS (.TERM_NUM) of
	set

	[SYMCLASS_RW] :
	    begin
	    if .FULL then APPEND_TO_TEXTM (.BUFNUM, 'keyword ');
	    DOWN_CASE (PAT$DATA_SYMBOL_TEXT (.TERM_NUM), TEMP_TEXT);
	    APPEND_TO_TEXTM (.BUFNUM, '"');
	    APPEND_TO_TEXTM (.BUFNUM, TEMP_TEXT);
	    APPEND_TO_TEXTM (.BUFNUM, '"');
	    end;

	[SYMCLASS_SPECIALCH] :
	    begin
	    APPEND_TO_TEXTM (.BUFNUM, '"');
	    APPEND_TO_TEXTM (.BUFNUM, PAT$DATA_SYMBOL_TEXT (.TERM_NUM));
	    APPEND_TO_TEXTM (.BUFNUM, '"');
	    end;

	[SYMCLASS_PATH_NAME, SYMCLASS_CDD_NAME] :
	    begin
	    if PAT$LSLOCAL_SYMBOL_CLASS (.TERM_NUM) EQLU T_PATH_NAME then
		APPEND_TO_TEXTM (.BUFNUM, 'path-name')
	    else
		APPEND_TO_TEXTM (.BUFNUM, 'variable-name');
	    APPEND_TO_TEXTM (.BUFNUM, ' ');
	    APPEND_TO_TEXTM (.BUFNUM, PAT$DATA_SYMBOL_TEXT (.TERM_NUM));
	    end;

	[SYMCLASS_NUMBER] :
	    begin
	    if .TERM_NUM eqlu T_HEX_NUMBER then
		APPEND_TO_TEXTM (.BUFNUM, 'hex-number')
	    else
		if .TERM_NUM eqlu T_OCTAL_NUMBER then
		    APPEND_TO_TEXTM (.BUFNUM, 'octal-number')
		else
		    APPEND_TO_TEXTM (.BUFNUM, 'number');
	    APPEND_TO_TEXTM (.BUFNUM, ' ');
	    APPEND_TO_TEXTM (.BUFNUM, PAT$DATA_SYMBOL_TEXT (.TERM_NUM));
	    end;

	[SYMCLASS_STRING, SYMCLASS_DESCR_TEXT] :
	    begin
	    if .TERM_NUM eqlu T_QUOTED_STRING then
		APPEND_TO_TEXTM (.BUFNUM, 'string-literal')
	    else
		APPEND_TO_TEXTM (.BUFNUM, 'description');
	    APPEND_TO_TEXTM (.BUFNUM, ' "');
	    APPEND_TO_TEXTM (.BUFNUM, PAT$DATA_SYMBOL_TEXT (.TERM_NUM));
	    APPEND_TO_TEXTM (.BUFNUM, '"');
	    end;

	[SYMCLASS_EOF] :
	    APPEND_TO_TEXTM (.BUFNUM, 'end-of-file');

	[SYMCLASS_NONTERM] :
	    0;
	tes;

    return TEXT_SD [.BUFNUM, SD_BASE]					! 002
    end;
!				Section 5

! 		Error message interface (global recovery)

!   Declarations for tables for global error recovery messages:


! Collection-type enumeration:

!   This is a list of the collections whose names can substitute
!   for a list of individual terminal symbols in the list
!   of possible symbols printed by PAT$LSLOCAL_GLOBAL_ERROR_MSG.
!
! The contents of this list are **LANGUAGE SPECIFIC**

ENUMERATION ('COLLECTION_TYPE', 0,
	GR_COL_NUMBER,			! Some kind of a number
	GR_COL_CDD_NAME,		! Some kind of a CDD name
	GR_COL_FIELD_ATT);		! Some field attribute

!   Number of literals in COLLECTION_TYPE

literal
    GR_NUM_COLLECTIONS = LAST_COLLECTION_TYPE - FIRST_COLLECTION_TYPE + 1;
! Non-Terminals-for-Terminal-Groupings Enumeration:

!   This is a list of the non-terminals symbols whose names can substitute
!   for a list of individual terminal symbols in the list
!   of possible symbols printed by PAT$LSLOCAL_GLOBAL_ERROR_MSG.
!   Note that LS_NUM_GROUP_NONTERMS in PATLANGSP.REQ should indicate
!   number of groupings.
!   The contents of this list are **LANGUAGE SPECIFIC**

ENUMERATION ('GROUPING_NONTERM', 0);

! None for this grammar.

!,
!    GR_GNT_DECL,			! Declarations
!    GR_GNT_STM,			! Statements
!    GR_GNT_EXP);			! Expressions
! Data Structures Used by Later Lists:

!   This structure definition is used for GR_COLLECTION_LISTS and
!   GR_GROUP_NONTERM_LISTS.
!
! For explanation of this data structure, see LR_BITMATRIX in PATLRTUNE.REQ.

structure
    ALIGNED_BITMATRIX [ROWNUM, BITNUM; ROWS, BITS] =
	[ROWS*((BITS + (%bpunit - 1))/%bpunit)]

	(ALIGNED_BITMATRIX + (ROWNUM*((BITS + (%bpunit - 1))/%bpunit))
	+ ((bitnum + %bpunit)/ %bpunit) - 1)
	<((BITNUM + %bpunit) mod %bpunit), 1>;
! Collection Lists:

!   This table is used in PAT$LSLOCAL_GLOBAL_ERROR_MSG when printing
!   an error message for global recovery.
!   Its indices are literals declared in the enumeration COLLECTION_TYPE
!   and literals for terminals declared by PATTABLE.
!   For each collection it has a bit set for each terminal included
!   in the collection.
!   For example, for Ada the collection NUMBER includes the terminals NUMBER
!   and REAL.
!  The contents of this table are **LANGUAGE SPECIFIC**

own
    GR_COLLECTION_LISTS : ALIGNED_BITMATRIX [GR_NUM_COLLECTIONS, PAT$DATA_NUM_TERM]
preset (

! Numbers:

	[GR_COL_NUMBER, T_UNSIGNED_INTEGER]		= TRUE,
	[GR_COL_NUMBER, T_SIGNED_INTEGER]		= TRUE,
	[GR_COL_NUMBER, T_FIXED_POINT]			= TRUE,
	[GR_COL_NUMBER, T_FLOATING_POINT]		= TRUE,
	[GR_COL_NUMBER, T_HEX_NUMBER]			= TRUE,
	[GR_COL_NUMBER, T_OCTAL_NUMBER]			= TRUE,

! CDD names:

	[GR_COL_CDD_NAME, T_ALIGNED]			= TRUE,
	[GR_COL_CDD_NAME, T_ARE]			= TRUE,
	[GR_COL_CDD_NAME, T_ARRAY]			= TRUE,
	[GR_COL_CDD_NAME, T_AS]				= TRUE,
	[GR_COL_CDD_NAME, T_ASCII_7]			= TRUE,
	[GR_COL_CDD_NAME, T_ASCII_8]			= TRUE,
	[GR_COL_CDD_NAME, T_ASCII_9]			= TRUE,
	[GR_COL_CDD_NAME, T_BASE]			= TRUE,
	[GR_COL_CDD_NAME, T_BASIC]			= TRUE,
	[GR_COL_CDD_NAME, T_BIT]			= TRUE,
	[GR_COL_CDD_NAME, T_BLANK]			= TRUE,
	[GR_COL_CDD_NAME, T_BOUNDARY]			= TRUE,
	[GR_COL_CDD_NAME, T_BY]				= TRUE,
	[GR_COL_CDD_NAME, T_BYTE]			= TRUE,
	[GR_COL_CDD_NAME, T_BYTES]			= TRUE,
	[GR_COL_CDD_NAME, T_CDD_NAME]			= TRUE,
	[GR_COL_CDD_NAME, T_CHARACTER]			= TRUE,
	[GR_COL_CDD_NAME, T_CHARACTERS]			= TRUE,
	[GR_COL_CDD_NAME, T_COBOL]			= TRUE,
	[GR_COL_CDD_NAME, T_COLUMN_MAJOR]		= TRUE,
	[GR_COL_CDD_NAME, T_COMPLEX]			= TRUE,
	[GR_COL_CDD_NAME, T_COMPUTED]			= TRUE,
	[GR_COL_CDD_NAME, T_CONDITION]			= TRUE,
	[GR_COL_CDD_NAME, T_COPY]			= TRUE,
	[GR_COL_CDD_NAME, T_DATATRIEVE]			= TRUE,
	[GR_COL_CDD_NAME, T_DATATYPE]			= TRUE,
	[GR_COL_CDD_NAME, T_DATE]			= TRUE,
	[GR_COL_CDD_NAME, T_DECIMAL]			= TRUE,
	[GR_COL_CDD_NAME, T_DEFAULT_VALUE]		= TRUE,
	[GR_COL_CDD_NAME, T_DEFINE]			= TRUE,
	[GR_COL_CDD_NAME, T_DEPENDING]			= TRUE,
	[GR_COL_CDD_NAME, T_DESCRIPTION]		= TRUE,
	[GR_COL_CDD_NAME, T_DIGIT]			= TRUE,
	[GR_COL_CDD_NAME, T_DIGITS]			= TRUE,
	[GR_COL_CDD_NAME, T_DTR]			= TRUE,
	[GR_COL_CDD_NAME, T_D_FLOATING]			= TRUE,
	[GR_COL_CDD_NAME, T_D_FLOATING_COMPLEX]		= TRUE,
	[GR_COL_CDD_NAME, T_EBCDIC_8]			= TRUE,
	[GR_COL_CDD_NAME, T_EBCDIC_9]			= TRUE,
	[GR_COL_CDD_NAME, T_EDIT_STRING]		= TRUE,
	[GR_COL_CDD_NAME, T_FIELD]			= TRUE,
	[GR_COL_CDD_NAME, T_FLOATING]			= TRUE,
	[GR_COL_CDD_NAME, T_FLOATING_COMPLEX]		= TRUE,
	[GR_COL_CDD_NAME, T_FOR]			= TRUE,
	[GR_COL_CDD_NAME, T_FRACTION]			= TRUE,
	[GR_COL_CDD_NAME, T_FRACTIONS]			= TRUE,
	[GR_COL_CDD_NAME, T_F_FLOATING]			= TRUE,
	[GR_COL_CDD_NAME, T_F_FLOATING_COMPLEX]		= TRUE,
	[GR_COL_CDD_NAME, T_G_FLOATING]			= TRUE,
	[GR_COL_CDD_NAME, T_G_FLOATING_COMPLEX]		= TRUE,
	[GR_COL_CDD_NAME, T_H_FLOATING]			= TRUE,
	[GR_COL_CDD_NAME, T_H_FLOATING_COMPLEX]		= TRUE,
	[GR_COL_CDD_NAME, T_IF]				= TRUE,
	[GR_COL_CDD_NAME, T_INDEXED]			= TRUE,
	[GR_COL_CDD_NAME, T_INITIAL_VALUE]		= TRUE,
	[GR_COL_CDD_NAME, T_JUSTIFIED]			= TRUE,
	[GR_COL_CDD_NAME, T_LEFT]			= TRUE,
	[GR_COL_CDD_NAME, T_LONGWORD]			= TRUE,
	[GR_COL_CDD_NAME, T_MISSING_VALUE]		= TRUE,
	[GR_COL_CDD_NAME, T_NAME]			= TRUE,
	[GR_COL_CDD_NAME, T_NUMERIC]			= TRUE,
	[GR_COL_CDD_NAME, T_OCCURS]			= TRUE,
	[GR_COL_CDD_NAME, T_OCTAWORD]			= TRUE,
	[GR_COL_CDD_NAME, T_OF]				= TRUE,
	[GR_COL_CDD_NAME, T_OVERPUNCHED]		= TRUE,
	[GR_COL_CDD_NAME, T_PACKED]			= TRUE,
	[GR_COL_CDD_NAME, T_PICTURE]			= TRUE,
	[GR_COL_CDD_NAME, T_PLI]			= TRUE,
	[GR_COL_CDD_NAME, T_POINTER]			= TRUE,
	[GR_COL_CDD_NAME, T_QUADWORD]			= TRUE,
	[GR_COL_CDD_NAME, T_QUERY_HEADER]		= TRUE,
	[GR_COL_CDD_NAME, T_QUERY_NAME]			= TRUE,
	[GR_COL_CDD_NAME, T_RIGHT]			= TRUE,
	[GR_COL_CDD_NAME, T_ROW_MAJOR]			= TRUE,
	[GR_COL_CDD_NAME, T_SCALE]			= TRUE,
	[GR_COL_CDD_NAME, T_SEPARATE]			= TRUE,
	[GR_COL_CDD_NAME, T_SIGNED]			= TRUE,
	[GR_COL_CDD_NAME, T_SIXBIT]			= TRUE,
	[GR_COL_CDD_NAME, T_STRING]			= TRUE,
	[GR_COL_CDD_NAME, T_STRUCTURE]			= TRUE,
	[GR_COL_CDD_NAME, T_SYNC]			= TRUE,
	[GR_COL_CDD_NAME, T_SYNCHRONIZED]		= TRUE,
	[GR_COL_CDD_NAME, T_TEXT]			= TRUE,
	[GR_COL_CDD_NAME, T_THRU]			= TRUE,
	[GR_COL_CDD_NAME, T_TIME]			= TRUE,
	[GR_COL_CDD_NAME, T_TIMES]			= TRUE,
	[GR_COL_CDD_NAME, T_TO]				= TRUE,
	[GR_COL_CDD_NAME, T_TYPE]			= TRUE,
	[GR_COL_CDD_NAME, T_UNSIGNED]			= TRUE,
	[GR_COL_CDD_NAME, T_UNSPECIFIED]		= TRUE,
	[GR_COL_CDD_NAME, T_VALID]			= TRUE,
	[GR_COL_CDD_NAME, T_VALUE]			= TRUE,
	[GR_COL_CDD_NAME, T_VALUES]			= TRUE,
	[GR_COL_CDD_NAME, T_VARIANT]			= TRUE,
	[GR_COL_CDD_NAME, T_VARYING]			= TRUE,
	[GR_COL_CDD_NAME, T_VIRTUAL]			= TRUE,
	[GR_COL_CDD_NAME, T_WHEN]			= TRUE,
	[GR_COL_CDD_NAME, T_WORD]			= TRUE,
	[GR_COL_CDD_NAME, T_ZERO]			= TRUE,
	[GR_COL_CDD_NAME, T_ZONED]			= TRUE,

! Field attributes:

	[GR_COL_FIELD_ATT, T_ALIGNED]			= TRUE,
	[GR_COL_FIELD_ATT, T_ARRAY]			= TRUE,
	[GR_COL_FIELD_ATT, T_BLANK]			= TRUE,
	[GR_COL_FIELD_ATT, T_COLUMN_MAJOR]		= TRUE,
	[GR_COL_FIELD_ATT, T_COMPUTED]			= TRUE,
	[GR_COL_FIELD_ATT, T_CONDITION]			= TRUE,
	[GR_COL_FIELD_ATT, T_DATATYPE]			= TRUE,
	[GR_COL_FIELD_ATT, T_DEFAULT_VALUE]		= TRUE,
	[GR_COL_FIELD_ATT, T_EDIT_STRING]		= TRUE,
	[GR_COL_FIELD_ATT, T_INITIAL_VALUE]		= TRUE,
	[GR_COL_FIELD_ATT, T_JUSTIFIED]			= TRUE,
	[GR_COL_FIELD_ATT, T_MISSING_VALUE]		= TRUE,
	[GR_COL_FIELD_ATT, T_NAME]			= TRUE,
	[GR_COL_FIELD_ATT, T_OCCURS]			= TRUE,
	[GR_COL_FIELD_ATT, T_PICTURE]			= TRUE,
	[GR_COL_FIELD_ATT, T_QUERY_HEADER]		= TRUE,
	[GR_COL_FIELD_ATT, T_QUERY_NAME]		= TRUE,
	[GR_COL_FIELD_ATT, T_ROW_MAJOR]			= TRUE,
	[GR_COL_FIELD_ATT, T_SYNC]			= TRUE,
	[GR_COL_FIELD_ATT, T_SYNCHRONIZED]		= TRUE,
	[GR_COL_FIELD_ATT, T_TYPE]			= TRUE,
	[GR_COL_FIELD_ATT, T_VALID]			= TRUE);
! Terminals-Into-Non-Terminal-Groups List:

!   This table is used in PAT$LSLOCAL_GLOBAL_ERROR_MSG when printing
!   an error message for global recovery.
!   Its indices are literals declared in the enumeration GROUPING_NONTERM
!   and literals for terminals declared by PATTABLE.
!   For each non-terminal it has a bit set for each terminal included
!   in the non-terminal.
!   For example, for Ada the collection STATEMENT includes all the terminal
!   symbols that can appear at the start of a statement.
!   The contents of this list are **LANGUAGE_SPECIFIC.**

! None for this grammar.

own
    GR_GROUP_NONTERM_LISTS : ALIGNED_BITMATRIX [LS_NUM_GROUP_NONTERMS, PAT$DATA_NUM_TERM];

!preset (

! Declarations:

!	[GR_GNT_DECL, T_ENTRY]		= TRUE,
!	[GR_GNT_DECL, T_FOR]		= TRUE,
!	[GR_GNT_DECL, T_FUNCTION]	= TRUE,
!	[GR_GNT_DECL, T_GENERIC]	= TRUE,
!	[GR_GNT_DECL, T_PACKAGE]	= TRUE,
!	[GR_GNT_DECL, T_PRAGMA]		= TRUE,
!	[GR_GNT_DECL, T_PROCEDURE]	= TRUE,
!	[GR_GNT_DECL, T_SUBTYPE]	= TRUE,
!	[GR_GNT_DECL, T_TASK]		= TRUE,
!	[GR_GNT_DECL, T_TYPE]		= TRUE,
!	[GR_GNT_DECL, T_USE]		= TRUE,
!	[GR_GNT_DECL, T_IDENTIFIER]	= TRUE,

! Statements:

!	[GR_GNT_STM, T_ABORT]		= TRUE,
!	[GR_GNT_STM, T_ACCEPT]		= TRUE,
!	[GR_GNT_STM, T_BEGIN]		= TRUE,
!	[GR_GNT_STM, T_CASE]		= TRUE,
!	[GR_GNT_STM, T_DECLARE]		= TRUE,
!	[GR_GNT_STM, T_DELAY]		= TRUE,
!	[GR_GNT_STM, T_EXIT]		= TRUE,
!	[GR_GNT_STM, T_FOR]		= TRUE,
!	[GR_GNT_STM, T_GOTO]		= TRUE,
!	[GR_GNT_STM, T_IF]		= TRUE,
!	[GR_GNT_STM, T_LOOP]		= TRUE,
!	[GR_GNT_STM, T_NULL]		= TRUE,
!	[GR_GNT_STM, T_PRAGMA]		= TRUE,
!	[GR_GNT_STM, T_RAISE]		= TRUE,
!	[GR_GNT_STM, T_RETURN]		= TRUE,
!	[GR_GNT_STM, T_SELECT]		= TRUE,
!	[GR_GNT_STM, T_WHILE]		= TRUE,
!	[GR_GNT_STM, T_LESS_LESS]	= TRUE,
!	[GR_GNT_STM, T_IDENTIFIER]	= TRUE,
!	[GR_GNT_STM, T_CHARACTER_STR]	= TRUE,

! Expressions:

!	[GR_GNT_EXP, T_NEW]		= TRUE,
!	[GR_GNT_EXP, T_NOT]		= TRUE,
!	[GR_GNT_EXP, T_NULL]		= TRUE,
!	[GR_GNT_EXP, T_L_PAREN]		= TRUE,
!	[GR_GNT_EXP, T_PLUS]		= TRUE,
!	[GR_GNT_EXP, T_MINUS]		= TRUE,
!	[GR_GNT_EXP, T_IDENTIFIER]	= TRUE,
!	[GR_GNT_EXP, T_NUMBER]		= TRUE,
!	[GR_GNT_EXP, T_CHARACTER_STR]	= TRUE,
!	[GR_GNT_EXP, T_CHARACTER_LIT]	= TRUE,
!	[GR_GNT_EXP, T_REAL]		= TRUE);
! Collection texts:

!   This table is used in PAT$LSLOCAL_GLOBAL_ERROR_MSG when printing
!   an error message for global recovery.
!   Its indices are literals declared in the enumeration COLLECTION_TYPE.
!   For each collection it has a pointer to a string descriptor containing the
!   text to be printed instead of the names of the terminals in the collection.
!   For example, for Ada the text for the collection ARITHOP is
!   "arithmetic-operator".
!   The contents of this table are **LANGUAGE SPECIFIC**

own
    gr_col_txt_number		: $str_descriptor (string = 'number'),
    gr_col_txt_CDD_name		: $str_descriptor (string = 'variable-name'),
    gr_col_txt_field_att	: $str_descriptor (string = 'field-attribute');

own
    GR_COLLECTION_TEXT : vector [GR_NUM_COLLECTIONS]

preset (
	[GR_COL_NUMBER]		= gr_col_txt_number,
	[GR_COL_CDD_NAME]	= gr_col_txt_CDD_name,
	[GR_COL_FIELD_ATT]	= gr_col_txt_field_att );
! Terminals-Into-Non-Terminal Groups Text Table:

!   This table is used in PAT$LSLOCAL_GLOBAL_ERROR_MSG when printing
!   an error message for global recovery.
!   Its indices are literals declared in the enumeration GROUPING_NONTERM.
!   For each non-terminal symbol it has a pointer to a string descriptor
!   containing the text to be printed instead of the names of the terminals
!   in the non-terminal symbol.  For example, for Ada the text for
!   the non-terminal symbol DECL is "declaration".
!  The contents of this table are **LANGUAGE SPECIFIC**.

! None for this grammar.

!own
!    gr_gnt_txt_decl	: $str_descriptor (string = 'declaration'),
!    gr_gnt_txt_stm	: $str_descriptor (string = 'statement'),
!    gr_gnt_txt_exp	: $str_descriptor (string = 'expression');

own
    GR_GROUP_NONTERM_TEXT : vector [LS_NUM_GROUP_NONTERMS];

!preset (
!	[GR_GNT_DECL]	= gr_gnt_txt_decl,
!	[GR_GNT_STM]	= gr_gnt_txt_stm,
!	[GR_GNT_EXP]	= gr_gnt_txt_exp );
! Group Non-Terminal Names:

!   This table is used in PAT$LSLOCAL_GLOBAL_ERROR_MSG when printing
!   an error message for global recovery.
!   The GR_NONTERM_SYMBOL field of each pair is a non-terminal
!   symbol which could be formed by a production containing an
!   errormark so it might be formed during global error recovery.
!   The corresponding GR_NONTERM_TEXT field contains a pointer to
!   a string descriptor containing text which describes that
!   non-terminal symbol.
!   The literals are used in defining and referencing the table.
!   A (less extensive) error message can be printed even if this
!   table is empty.
!   The contents of this table are **LANGUAGE SPECIFIC**.

! None for this grammar.

literal
    GR_NUM_NONTERM_NAMES = 0,			! **LANGUAGE SPECIFIC**
    GR_NONTERM_SYMBOL = 0,
    GR_NONTERM_TEXT = 1;

structure
    LS_MATRIX [ROWNUM, COLNUM; ROWS, COLS] =
	[(ROWS*COLS)*%upval]
	(LS_MATRIX + ((ROWNUM*COLS) + COLNUM)*%upval);

! own
!    gr_ntm_nam_decl		: $str_descriptor (string = 'declaration'),
!    gr_ntm_nam_stm		: $str_descriptor (string = 'statement');

own
    GR_NONTERM_NAMES : LS_MATRIX [GR_NUM_NONTERM_NAMES, 2];

!preset (
!	[0, GR_NONTERM_SYMBOL]	= NT_DECL,
!	[0, GR_NONTERM_TEXT]	= gr_ntm_nam_decl,

!	[1, GR_NONTERM_SYMBOL]	= NT_UNLABELLED_STM,
!	[1, GR_NONTERM_TEXT]	= gr_ntm_nam_stm );
global routine PAT$LSLOCAL_EXPECTED_SYMBOL (SYM, REF_GROUP_NONTERMS_SEEN, REF_TERMS_TO_PRINT) : novalue =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	See LS_EXPECTED_SYMBOL macro in PATLANGSP.REQ.
!	LS_EXPECTED_SYMBOL adds the symbol SYM to the set of symbols expected
!	in a global recovery error message by setting fields in
!	GR_GROUP_NONTERMS_SEEN and GR_TERMS_TO_PRINT appropriately.
!
! FORMAL PARAMETERS:
!
!	SYM			Terminal or non-terminal symbol
!	REF_GROUP_NONTERMS_SEEN	Pointer to table of important grouping
!				non-terminals, indicating which have been seen
!	REF_TERMS_TO_PRINT	Pointer to table of terminals,
!				indicating which were expected
!
! IMPLICIT INPUTS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! ROUTINE VALUE:
!
!	None.
!
! SIDE EFFECTS:
!
!	None.
!
!--

    begin

    bind
	GR_GROUP_NONTERMS_SEEN = .REF_GROUP_NONTERMS_SEEN : bitvector [],
	GR_TERMS_TO_PRINT = .REF_TERMS_TO_PRINT : bitvector [];

    if PAT$LSLOCAL_SYMBOL_CLASS (.SYM) eql SYMCLASS_NONTERM
    then 					! Non-terminal

! **LANGUAGE-SPECIFIC** case for each group non-terminal:
! (None for this grammar.)

	selectone .SYM of
	    set
!	    [NT_DECL] : 			! Declaration
!		GR_GROUP_NONTERMS_SEEN [GR_GNT_DECL] = TRUE;
!
!	    [NT_STM] : 				! Statement
!		GR_GROUP_NONTERMS_SEEN [GR_GNT_STM] = TRUE;
!
!	    [NT_SIMPLE_EXP] : 			! Expression
!		GR_GROUP_NONTERMS_SEEN [GR_GNT_EXP] = TRUE;

	    [otherwise] :
	    ;					! Other non-terminal--do nothing
	    tes

    else 					! Ordinary terminal symbol
	GR_TERMS_TO_PRINT [.SYM] = TRUE;

    end;
global routine PAT$LSLOCAL_GLOBAL_ERROR_MSG (BAD_NON_TERM, ERROR_TOKEN_PTR, REF_GROUP_NONTERMS_SEEN,
    REF_TERMS_TO_PRINT, BYTES_FOR_TERMS) : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
!	See LS_GLOBAL_ERROR_MSG macro in PATLANGSP.REQ.
!	LS_GLOBAL_ERROR_MSG outputs an error message for global error
!	recovery.
!
!	The global error recovery that has been done will evenutally
!	result in the recognition of some production containing an
!	errormark:
!
!		LHS_NON_TERMINAL_NAME = ... errormark ... ;
!
!	where ... indicates a sequence of terminal/nonterminal symbols.
!	The symbol number of the non-terminal on the left hand side
!	(LHS_NON_TERMINAL_NAME above) will be passed as parameter
!	BAD_NON_TERM if it can be determined easily.  (It can be determined
!	easily if the "..." on the right of the errormark consists of a
!	single terminal symbol.)  Otherwise LS_UNAVAILABLE_NT will be passed.
!
!	This information permits errors of the form:
!
!		Invalid statement--Found ... when expecting ...
!
!	instead of
!
!		Found ... when expecting ...
!
! FORMAL PARAMETERS:
!
!	BAD_NON_TERM			Number of non-terminal symbol
!	ERROR_TOKEN_PTR			Pointer to token at which error
!					was encountered
!	REF_GROUP_NONTERMS_SEEN		Pointer to bit-vector indicating which
!					important group non-terminals
!					were expected (can be modified)
!	REF_TERMS_TO_PRINT		Pointer to bit-vector indicating which
!					terminal symbols were expected
!					(can be modified)
!	BYTES_FOR_TERMS			Number of bytes used by TERMS-TO-PRINT
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	None
!
! ROUTINE VALUE:
!
!	None.
!
! SIDE EFFECTS:
!
!	The error message is printed.
!
!--
    begin

    map
	ERROR_TOKEN_PTR : ref LSLOCAL_TKN_STR;

    bind
	GROUP_NONTERMS_SEEN = .REF_GROUP_NONTERMS_SEEN : bitvector [],
	TERMS_TO_PRINT = .REF_TERMS_TO_PRINT : bitvector [];

    local
	ERROR_LOC,
	NUM_GROUP_NONTERMS_TO_PRINT,
	NUM_COLLECTIONS_TO_PRINT,
	NUM_TERMS_TO_PRINT,
	NUM_ITEMS_TO_PRINT,
	COLLECTIONS_SEEN : bitvector [GR_NUM_COLLECTIONS + 1], ! + 1 so size isn't 0
	UNACCEPTED_TERMS_IN_COLLECTION : bitvector [PAT$DATA_NUM_TERM],
	TERMS_SEEN_IN_COLLECTION : bitvector [PAT$DATA_NUM_TERM];

    literal
	BUF0 = 0,
	BUF1 = 1,
	BUF2 = 2;
! Macros

! Given two bitvectors, DST (destination) and SRC (source),
! each of which occupies NUM_BYTES storage, this macro performs the
! vector operation:
!
!	DST = DST and not SRC

    macro
	BLOCK_DST_AND_NOT_SRC (SRC, DST, NUM_BYTES) =
	    begin
	    bind
		SBV = SRC : bitvector [],				! 002
		DBV = DST : bitvector [];				! 002

	    incr OFFSET from 0 to (NUM_BYTES - 1) do
		DBV [.OFFSET] = .DBV [.OFFSET] and (not .SBV [.OFFSET]);
	    end
	%;

! Given three bit vectors SRC1, SCR2, and DST, each of which
! occupies NUM_BYTES storage, this macro performs the
! vector operation:
!
!	DST = SRC1 and SRC2

    macro
	BLOCK_SRC1_AND_SRC2_TO_DST (SRC1, SRC2, DST, NUM_BYTES) =
	    begin
	    bind
		SBV1 = SRC1 : bitvector [],				! 002
		SBV2 = SRC2 : bitvector [],				! 002
		DBV = DST : bitvector [];				! 002

	    incr OFFSET from 0 to (NUM_BYTES - 1) do
		DBV [.OFFSET] = .SBV1 [.OFFSET] and .SBV2 [.OFFSET];
	    end
	%;

! Given three bit vectors SRC1, SCR2, and DST, each of which
! occupies NUM_BYTES storage, this macro performs the
! vector operation:
!
!	DST = SRC1 and not SRC2

    macro
	BLOCK_SRC1_AND_NOT_SRC2_TO_DST (SRC1, SRC2, DST, NUM_BYTES) =
	    begin
	    bind
		SBV1 = SRC1 : bitvector [],				! 002
		SBV2 = SRC2 : bitvector [],				! 002
		DBV = DST : bitvector [];				! 002

	    incr OFFSET from 0 to (NUM_BYTES - 1) do
		DBV [.OFFSET] = .SBV1 [.OFFSET] and (not .SBV2 [.OFFSET]);
	    end
	%;
! This macro counts the number of bits set turned on in a
! bitvector at address START of length NUM_BITS.

    macro
	COUNT (START, NUM_BITS) =
	    begin
	    local
		TOT;

	    TOT = 0;
	    incr LOOP_INDEX from 0 to (NUM_BITS - 1) do
		if .START [.LOOP_INDEX] then TOT = .TOT + 1;
	    .TOT
	    end
	%;
! Start of code for PAT$LSLOCAL_GLOBAL_ERROR_MSG

    ! Determine what's expected.

    ! If group non-terminals are expected, say a statement,
    ! suppress output for all terminals that can begin a
    ! statement (for example, "for", "loop") by turning off the bits
    ! in TERMS_TO_PRINT bitvector.  (Note that TERMS_TO_PRINT
    ! in indexed by the terminal symbol number.

    incr GROUP_NONTERM_INDEX from FIRST_GROUPING_NONTERM to LAST_GROUPING_NONTERM do

	if (.GROUP_NONTERMS_SEEN [.GROUP_NONTERM_INDEX])
	then
	    BLOCK_DST_AND_NOT_SRC (		!
		GR_GROUP_NONTERM_LISTS [.GROUP_NONTERM_INDEX, PAT$DATA_FIRST_TERM],
		TERMS_TO_PRINT, .BYTES_FOR_TERMS);

    ! If some of the terminals that are expected form a
    ! collection (for example "+", "-", "*", ... in collection
    ! "arithmetic-operator"), suppress output for these terminals
    ! ("+", etc.) by turning off the associated bits in TERMS_TO_PRINT
    ! bitvector.  Set bit in COLLECTIONS_SEEN bitvector to
    ! indicate that "arithmetic-operator" is to be output.

!    ZEROBYTE (%allocation (COLLECTIONS_SEEN), COLLECTIONS_SEEN);
    incr counter from 0 to GR_NUM_COLLECTIONS
	do collections_seen [.counter] = 0;

    incr COLLECTION_INDEX from FIRST_COLLECTION_TYPE to LAST_COLLECTION_TYPE do
	begin
	BLOCK_SRC1_AND_SRC2_TO_DST (
	    GR_COLLECTION_LISTS [.COLLECTION_INDEX, PAT$DATA_FIRST_TERM],
	    TERMS_TO_PRINT, TERMS_SEEN_IN_COLLECTION, .BYTES_FOR_TERMS);
	BLOCK_SRC1_AND_NOT_SRC2_TO_DST (
	    GR_COLLECTION_LISTS [.COLLECTION_INDEX, PAT$DATA_FIRST_TERM],
	    TERMS_TO_PRINT, UNACCEPTED_TERMS_IN_COLLECTION, .BYTES_FOR_TERMS);

	if (COUNT (TERMS_SEEN_IN_COLLECTION, PAT$DATA_NUM_TERM) gtr 0) and
	    (COUNT (UNACCEPTED_TERMS_IN_COLLECTION, PAT$DATA_NUM_TERM) eql 0)
	then
	    begin
	    COLLECTIONS_SEEN [.COLLECTION_INDEX] = TRUE;
	    BLOCK_DST_AND_NOT_SRC (
		GR_COLLECTION_LISTS [.COLLECTION_INDEX, PAT$DATA_FIRST_TERM],
		TERMS_TO_PRINT, .BYTES_FOR_TERMS);
	    end;
	end;

    ! Determine the number of items expected

    NUM_GROUP_NONTERMS_TO_PRINT = COUNT (GROUP_NONTERMS_SEEN, LS_NUM_GROUP_NONTERMS);
    NUM_COLLECTIONS_TO_PRINT = COUNT (COLLECTIONS_SEEN, GR_NUM_COLLECTIONS);
    NUM_TERMS_TO_PRINT = COUNT (TERMS_TO_PRINT, PAT$DATA_NUM_TERM);
    NUM_ITEMS_TO_PRINT = .NUM_GROUP_NONTERMS_TO_PRINT + .NUM_COLLECTIONS_TO_PRINT + .NUM_TERMS_TO_PRINT;
    DEB_ASSERT ((.NUM_ITEMS_TO_PRINT gtr 0),
	'Nothing "expected" for global error recovery');

    ! Create a text string in text buffer 0 (BUF0) containing a
    ! general header if expecting something important;  for example
    !
    !	Illegal statement-- ...

    CLEAR_TEXTM (BUF0);

    if .BAD_NON_TERM neq LS_UNAVAILABLE_NT
    then

	incr LOOP_INDEX from 0 to (GR_NUM_NONTERM_NAMES - 1) do

	    if .GR_NONTERM_NAMES [.LOOP_INDEX, GR_NONTERM_SYMBOL] eql .BAD_NON_TERM
	    then
		begin
		APPEND_TO_TEXTM (BUF0, 'Illegal ');
		APPEND_TO_TEXTM (BUF0, .GR_NONTERM_NAMES [.LOOP_INDEX, GR_NONTERM_TEXT]);
		APPEND_TO_TEXTM (BUF0, '--');
		exitloop;
		end;

    ! Create a text string in buffer 1 (BUF1) consisting of items expected.
    ! If more than one item is expected, bracket them with curly braces.

    CLEAR_TEXTM (BUF1);

    if .NUM_ITEMS_TO_PRINT gtr 1 then APPEND_TO_TEXTM (BUF1, 'one of { ');

    ! First list important group nonterminals expected (for example, statement).

    if .NUM_GROUP_NONTERMS_TO_PRINT neq 0
    then

	incr GROUP_NONTERM_INDEX from FIRST_GROUPING_NONTERM to LAST_GROUPING_NONTERM do

	    if (.GROUP_NONTERMS_SEEN [.GROUP_NONTERM_INDEX])
	    then
		begin
		APPEND_TO_TEXTM (BUF1, .GR_GROUP_NONTERM_TEXT [.GROUP_NONTERM_INDEX]);
		APPEND_TO_TEXTM (BUF1, ' ');
		end;

    ! Then comes the collections (for example, arithmetic-operator)

    if .NUM_COLLECTIONS_TO_PRINT neq 0
    then

	incr COL_INDEX from FIRST_COLLECTION_TYPE to LAST_COLLECTION_TYPE do

	    if (.COLLECTIONS_SEEN [.COL_INDEX])
	    then
		begin
		APPEND_TO_TEXTM (BUF1, .GR_COLLECTION_TEXT [.COL_INDEX]);
		APPEND_TO_TEXTM (BUF1, ' ');
		end;

    ! Then individual terminals.

    if .NUM_TERMS_TO_PRINT neq 0
    then

	incr TERM_INDEX from PAT$DATA_FIRST_TERM to PAT$DATA_LAST_TERM do

	    if (.TERMS_TO_PRINT [.TERM_INDEX])
	    then
		begin
		APPEND_TO_TEXTM (BUF1, PAT$LSLOCAL_OUTPUT_TERM (.TERM_INDEX, FALSE, BUF2));
		APPEND_TO_TEXTM (BUF1, ' ');
		end;

    if .NUM_ITEMS_TO_PRINT gtr 1 then APPEND_TO_TEXTM (BUF1, '}');

    ! Output the error message.

    ERROR_LOC = LS_LEX_LOCATOR (ERROR_TOKEN_PTR);
    LSLOCAL_SYNTAX_ERROR_START (.ERROR_LOC);

    ! Put out general header.

    LSLOCAL_SYNTAX_ERROR_TEXTM (.ERROR_LOC,TEXT_SD[BUF0,STR$H_LENGTH]);	! 002

    ! Put out
    !
    !	Found ... when expecting ...

    LSLOCAL_SYNTAX_ERROR_TEXTM (.ERROR_LOC, 'Found ', PAT$LSLOCAL_OUTPUT_TOKEN (.ERROR_TOKEN_PTR, BUF2));
    LSLOCAL_SYNTAX_ERROR_TEXTM (.ERROR_LOC, ' when expecting ');
    LSLOCAL_SYNTAX_ERROR_TEXTM(.ERROR_LOC,TEXT_SD[BUF1,STR$H_LENGTH]);	! 002
    LSLOCAL_SYNTAX_ERROR_END (.ERROR_LOC);

%IF %BLISS (BLISS36) %THEN
    BEGIN
    library 'fao';
    EXTERNAL pinfile : $STR_DESCRIPTOR();       ! defined in PATPOR.BLI
    LOCAL errstr : $STR_DESCRIPTOR(CLASS = DYNAMIC),
          loc_desc : REF $STR_DESCRIPTOR();

    $STR_DESC_INIT (DESC = errstr, CLASS = DYNAMIC);

    $STR_APPEND (STRING =
                $STR_CONCAT ('Error on line ',
                             $STR_ASCII(LS_LEX_LINE_NUMBER(.error_loc),BASE10),
                             ' column ',
                             $STR_ASCII (LS_LEX_COLUMN_NUMBER (.error_loc),
                                         BASE10),
                             ' of ',
                             pinfile,
                             ':  '),
               TARGET = errstr);

    CLEAR_TEXTM (BUF0);

!    IF .bad_non_term NEQ LS_UNAVAILABLE_NT
!    THEN
     INCR loop_index FROM 0 TO (GR_NUM_NONTERM_NAMES - 1) DO
        IF .gr_nonterm_names [.loop_index, GR_NONTERM_SYMBOL] EQL .bad_non_term
	    THEN BEGIN
                 APPEND_TO_TEXTM (BUF0, 'Illegal ');
                 APPEND_TO_TEXTM (BUF0, .gr_nonterm_names[.loop_index,
                                                          GR_NONTERM_TEXT]);
                 APPEND_TO_TEXTM (BUF0, '--');
                 EXITLOOP;
                 END;

    $STR_APPEND (STRING = (.text_sd [BUF0, STR$H_LENGTH], text_0buf),
                 TARGET = errstr);

    loc_desc = PAT$LSLOCAL_OUTPUT_TOKEN(.error_token_ptr, BUF2);
    
    $STR_APPEND (STRING =
                 $STR_CONCAT (%CHAR (13,10),    ! <crlf>
                              'Found ',
                              (.text_sd [BUF2, STR$H_LENGTH], 
                               .text_sd [BUF2, STR$A_POINTER]),
                              ' when expecting ',
                              (.text_sd [BUF1, STR$H_LENGTH],
                               .text_sd [BUF1, STR$A_POINTER])
                              ),
                 TARGET = errstr);

    ! SIGNAL the error...
    SIGNAL (DIU$_PATPAR, 1, errstr, 0);

    END;

    %FI

    end;					! Of routine PAT$LSLOCAL_GLOBAL_ERROR_MSG
!				Section 6

!   Other definitions
routine APPEND_TO_TEXT (BUFNUM, NEW_TEXT) : novalue =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Add more text to an error message.
!
! FORMAL PARAMETERS:
!
!	BUFNUM		Buffer number to build message in.
!	NEW_TEXT	String descriptor to the next text.
!
! IMPLICIT INPUTS:
!
!	Text buffer.
!
! IMPLICIT OUTPUTS:
!
!	Text buffer.
!
! ROUTINE VALUE:
!
!	None.
!
! SIDE EFFECTS:
!
!	None.
!
!--

    begin
    local								! 002
	dots: $STR_DESCRIPTOR (string = ' ...');			! 002

    map
	NEW_TEXT : ref $STR_DESCRIPTOR ();				! 002

    if .TEXT_BUF_FULL [.BUFNUM] then return;

    if .TEXT_SD [.BUFNUM, STR$H_LENGTH] + .NEW_TEXT [STR$H_LENGTH]	! 002
	gtr .TEXT_BUF_SIZE [.BUFNUM] - 4				! 002
    then
	begin
	TEXT_BUF_FULL [.BUFNUM] = TRUE;
	ch$move (4, dots [STR$A_POINTER],				! 002
	    ch$plus (.TEXT_SD [.BUFNUM, STR$A_POINTER],			! 002
		.TEXT_SD [.BUFNUM, STR$H_LENGTH]) );			! 002
	TEXT_SD [.BUFNUM, STR$H_LENGTH] =				! 002
	    .TEXT_SD [.BUFNUM, STR$H_LENGTH] + 4;			! 002
	return
	end;

    ch$move (.NEW_TEXT [STR$H_LENGTH], .NEW_TEXT [STR$A_POINTER],	! 002
	ch$plus (.TEXT_SD [.BUFNUM, STR$A_POINTER],			! 002
	    .TEXT_SD [.BUFNUM, STR$H_LENGTH]) );			! 002
    TEXT_SD [.BUFNUM, STR$H_LENGTH] =					! 002
	.TEXT_SD [.BUFNUM, STR$H_LENGTH] + .NEW_TEXT [STR$H_LENGTH];	! 002
    end;
routine DOWN_CASE (IN, OUT) : novalue =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Convert a string to all lower case.
!
! FORMAL PARAMETERS:
!
!	IN	XPORT descriptor of original string
!	OUT	XPORT descriptor of resultant string
!
! IMPLICIT INPUTS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! ROUTINE VALUE:
!
!	None.
!
! SIDE EFFECTS:
!
!	None.
!
!--

    begin

    bind
		    DOWNCASE_TABLE = ch$transtable (! 002
		    %c' ', %c' ', %c' ', %c' ',	! 002 NUL, SOH, STX, ETX
		    %c' ', %c' ', %c' ', %c' ',	! 002 EOT, ENQ, ACK, BEL
		    %c' ', %c' ', %c' ', %c' ',	! 002  BS,  HT,  LF,  VT
		    %c' ', %c' ', %c' ', %c' ',	! 002  FF,  CR,  SO,  SI
		    %c' ', %c' ', %c' ', %c' ',	! 002 DLE, DC1, DC2, DC3
		    %c' ', %c' ', %c' ', %c' ',	! 002 DC4, NAK, SYN, ETB
		    %c' ', %c' ', %c' ', %c' ',	! 002 CAN,  EM, SUB, ESC
		    %c' ', %c' ', %c' ', %c' ',	! 002  FS,  GS,  RS,  US
		    %c' ', %c' ', %c' ', %c' ',	! 002  SP,   !,   ",   #
		    %c'$', %c' ', %c' ', %c' ',	! 002   $,   %,   &,   '
		    %c' ', %c' ', %c' ', %c' ',	! 002   (,   ),   *,   +
		    %c' ', %c'-', %c'-', %c' ',	! 002   ,,   -,   .,   /
		    %c'0', %c'1', %c'2', %c'3',	! 002   0,   1,   2,   3
		    %c'4', %c'5', %c'6', %c'7',	! 002   4,   5,   6,   7
		    %c'8', %c'9', %c' ', %c';',	! 002   8,   9,   :,   ;
		    %c' ', %c' ', %c' ', %c' ',	! 002   <,   =,   >,   ?
		    %c' ', %c'a', %c'b', %c'c',	! 002   @,   A,   B,   C
		    %c'd', %c'e', %c'f', %c'g',	! 002   D,   E,   F,   G
		    %c'h', %c'i', %c'j', %c'k',	! 002   H,   I,   J,   K
		    %c'l', %c'm', %c'n', %c'o',	! 002   L,   M,   N,   O
		    %c'p', %c'q', %c'r', %c's',	! 002   P,   Q,   R,   S
		    %c't', %c'u', %c'v', %c'w',	! 002   T,   U,   V,   W
		    %c'x', %c'y', %c'z', %c' ',	! 002   X,   Y,   Z,   [
		    %c' ', %c' ', %c' ', %c'_',	! 002   \,   ],   ^,   _
		    %c' ', %c'a', %c'b', %c'c',	! 002   `,   a,   b,   c
		    %c'd', %c'e', %c'f', %c'g',	! 002   d,   e,   f,   g
		    %c'h', %c'i', %c'j', %c'k',	! 002   h,   i,   j,   k
		    %c'l', %c'm', %c'n', %c'o',	! 002   l,   m,   n,   o
		    %c'p', %c'q', %c'r', %c's',	! 002   p,   q,   r,   s
		    %c't', %c'u', %c'v', %c'w',	! 002   t,   u,   v,   w
		    %c'x', %c'y', %c'z', %c' ',	! 002   x,   y,   z,   {
		    %c' ', %c' ', %c' ', %c' ');! 002   |,   },   ~, DEL

    map
	IN : ref $STR_DESCRIPTOR (),					! 002
	OUT : ref $STR_DESCRIPTOR ();					! 002

    OUT [STR$H_LENGTH] = .IN [STR$H_LENGTH];				! 002
    ch$translate (DOWNCASE_TABLE, .IN [STR$H_LENGTH],			! 002
	.IN [STR$A_POINTER], 0, .OUT [STR$H_LENGTH],			! 002
	.OUT [STR$A_POINTER]);						! 002
    end;
end						! End of module

eludom