Trailing-Edge
-
PDP-10 Archives
-
CFS_TSU04_19910205_1of1
-
update/t20src/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