!<BLF/macro>
!<BLF/lowercase_user>
!<BLF/uppercase_key>
MODULE lex (					!

%IF %BLISS (BLISS32)
%THEN
		    ADDRESSING_MODE (EXTERNAL = LONG_RELATIVE, 	!
		    NONEXTERNAL = LONG_RELATIVE) ,
%FI

		IDENT = '8.3'
		) =
BEGIN

!++
! FACILITY: BLISS Formatter
!
! ABSTRACT:
!	This module contains the interface between the scanner,
!	which returns each token from the input stream, and
!	the parser, which is in control of the process of getting
!	and disposing of lexemes.
!
!	LEX$GETSYM communicates with the output module to format
!	lexemes which must be formatted at the lexical level,
!	e.g. %IF.
!
! Environment: Transportable, with XPORT
!
!
! REVISION HISTORY
!
!	 8-Oct-81	TT	Inserted all new builtins for Bliss V2.1
!				and V3. Note that some are machine-specific
!				but are in this list nevertheless. When things
!				get commonized this should be fixed.
!
!	12-Oct-81	TT	Add s_empty as a type. For now, this is
!				basically a no-op. It'll be used in the future
!				to help parse empty macros IE %ASSIGN. This is
!				already in the 10/20 version, so it will help
!				in commonization as well.
!
!	20-Oct-81	TT	Add NODEFAULT and %REQUIRE into the keyword
!				list. Bumped indent to 7.0 from 6.3-6.
!
!	19-Jan-82	TT	Added EMUL, EDIV builtins. Remove unused
!				external declaration of Lst$line.
!
!	21-Jan-82	TT	STACKLOCAL was declared twice; causing
!				  it to be looked at as just a name!
!
!	12-Feb-82	TT	Per user request, allow !<BLF/ to be any
!				combination of upper or lower case.
!
! END OF REVISION HISTORY
!--

!<BLF/page>

!++
! Table of contents:
!--

FORWARD ROUTINE
    lex$def_synonym : NOVALUE,			! Process synonym control line
    lex$getsym : NOVALUE,			! Main interface from parser
    lex$init : NOVALUE,				! Data initialization
    lookup : NOVALUE;				! Loookup names known to BLISS

!++
! Include files:
!--

REQUIRE 'BLFCSW';				! Defines control switches, i.e. 'sw_...'

REQUIRE 'SCNBLK';				! Defines variables pertaining to scanning context

REQUIRE 'TOKTYP';				! Defines 'token' and the token type values 's_...'

REQUIRE 'UTLCOD';				! Defines error codes, i.e. 'er_...'

!++
! Macros:
!--

MACRO
    plit_count (aplit) =
	((aplit) - %UPVAL) %;

MACRO
    scnt (s) =
	%CHARCOUNT (s), UPLIT(s) %;

!++
! Equated Symbols:
!--

LITERAL
    true = 1 EQL 1,
    false = 1 NEQ 1,
    casebit = %C'A' XOR %c'a',
    entry_size = 3;				! In LOOKUP's table

LITERAL
    special_token = s_multiply,
    lex_list_size = 400,			! Total symbols in synonym list
    syn_name_len = 31,
    syn_table_size = 50;			! max no. of synonyms permitted

FIELD
    syn_field =
	SET
	first_lex_syn = [0, 0, %BPVAL, 0],	!
	final_lex_syn = [1, 0, %BPVAL, 0],	!
	lth_syn_name = [2, 0, %BPVAL, 0],	!
	syn_name = [3, 0, 0, 0]			!
	TES;

!++
! Own storage:
!--

OWN
    comment : VECTOR [CH$ALLOCATION (buf_len)],	! Buffer for comment lines
    last_tok : INITIAL (null_symbol);		! = s_name if must issue space

OWN
    syn_state : BLOCK [scn_blk_size] FIELD (in_field),
    stk : REF BLOCK FIELD (in_field) INITIAL (syn_state);

OWN
    lex_index,
    lex_list : VECTOR [lex_list_size],		! List of lexeme types defining synonyms
    syn_index,
    syn_list : BLOCKVECTOR 			!
	[syn_table_size, 3 + CH$ALLOCATION (syn_name_len)]	!
	FIELD (syn_field);

OWN
    cur_lex : INITIAL (1),			! Subscript of first synonym lexeme
    end_lex : INITIAL (0),			! Subscript of final synonym lexeme
    index,					! Subscript of synonym entry in table
    match;					! True if name has synonym.

GLOBAL
    tok : INITIAL (s_eludom);			! Returned symbol

!++
!	The following variable is a count of the level of %IF control.
!	It is used to permit or suppress ejects in OUTPUT.
!--

GLOBAL
    in_pc_if : INITIAL (0);

!++
! External references:
!--

EXTERNAL ROUTINE 				!
    ctl$command : NOVALUE,			! Process command comments
    ctl$switch,					! Values of switches
    lst$dot : NOVALUE,				! Set dotting flag for listing
    lst$line : NOVALUE,				! Write line to listing file
    lst$subtitle : NOVALUE,			! Save subtitle
    lst$title : NOVALUE,			! Save title
    out$break : NOVALUE,			! Break the current line
    out$comment : NOVALUE,			! Output comment or remark
    out$eject : NOVALUE,			! Eject current page
    out$force : NOVALUE,			! Force a BREAK on next token
    out$indent : NOVALUE,			! Set relative indent level
    out$nit : NOVALUE,				! (Re-)initialize output
    out$ntbreak : NOVALUE,			! BREAK but don't tab.
    out$pend_skip : NOVALUE,			! Skip a line after this one
    out$print : NOVALUE,			! Debugging printer
    out$remark : NOVALUE,			! Output an end-of-line comment
    out$skip : NOVALUE,				! Skip lines
    out$space : NOVALUE,			! Output n spaces
    out$stoks : NOVALUE,			! Output space/token/space
    out$tab : NOVALUE,				! Output a TAB character, or if
    						!  at beginning, TAB to Indent level
    out$tok : NOVALUE,				! Output the current token
    prs$block : NOVALUE,			! Parse1
    prs$expression : NOVALUE,			! Format an expression
    prs$_mac_level,				! = Current macro def level
    scn$fin_verb : NOVALUE,			! Reenter automatic mode
    scn$getsym : NOVALUE,			! Scanner
    scn$pop : NOVALUE,				! Scanner state stack
    scn$push : NOVALUE,				! Scanner state stack
    scn$strt_verb : NOVALUE,			! Enter manual mode
    utl$error : NOVALUE;			! Central ERROR reporting

EXTERNAL 					!
    token : tok_block;				! Only one token processed at a time

GLOBAL ROUTINE lex$def_synonym (arg) : NOVALUE = 	!

!++
! Functional description:
!	This routine analyses a control statement of the form
!	!<BLF/synonym name=token1 token2 ...>
!	It adds an entry, "name", to the synonym table so that future
!	references to "name" can be replaced by the token stream.
!
! Formal parameters:
!	arg - a character pointer to the text of the definition, i.e.
!		after "!<blf/synonym " has been passed over.
!
! Implicit inputs:
!	None
!
! Implicit outputs:
!	A new entry in the synonym table.
!
! Routine value:
!	None
!
! Side effects:
!	None
!--

    BEGIN

    LOCAL
	ch,
	lth,
	ptr;

    ! Set up the scanning context for the synonym token list.
    stk [cp] = .arg;
    stk [rem] = stk [len] = buf_len - 13;	! 13 = len(!<blf/synonym)
    stk [col] = 1;
    stk [chr] = null_symbol;
    scn$push (syn_state);			! Direct scanner to scan rest of synonym definition
    lex$getsym ();				! Get the name of the synonym

    IF .tok NEQ s_name THEN (utl$error (er_syn_def); scn$pop (); RETURN );

!+
!	Enter the newly found name (capitalized) into the table
!-
    ! Capitalize name before moving to table
    lth = MIN (syn_name_len, .token [tok_len]);
    ptr = .token [tok_cp];

    INCR i FROM 1 TO .lth DO
	BEGIN
	ch = CH$RCHAR (.ptr);

	IF .ch GEQ %C'a' AND .ch LEQ %C'z'
	THEN
	    CH$WCHAR_A (.ch XOR casebit, ptr)	!
	ELSE
	    ptr = CH$PLUS (.ptr, 1);

	END;

    CH$COPY (.token [tok_len],			!
	.token [tok_cp],			!
	%C' ', 					!
	syn_name_len, 				!
	CH$PTR (syn_list [.syn_index, syn_name]));
    syn_list [.syn_index, lth_syn_name] = .lth;
    lex$getsym ();

    IF .tok EQL s_equal
    THEN
	BEGIN
	! Begin fetching lexemes from the line
	lex$getsym ();

	UNTIL .token [tok_type] EQL s_rangle OR 	!
	    .token [tok_type] EQL s_end_of_file OR 	!
	    .token [tok_type] EQL s_newline OR 	!
	    .lex_index GEQ lex_list_size DO
	    BEGIN
	    lex_list [.lex_index] = .token [tok_type];
	    lex_index = .lex_index + 1;
	    lex$getsym ();
	    END;

	syn_list [.syn_index, final_lex_syn] = .lex_index;
	syn_index = .syn_index + 1;
	syn_list [.syn_index, first_lex_syn] = .lex_index;
	END;

    scn$pop ();					! Resume normal scanning
    END;					! End of routine 'lex$def_synonym'

GLOBAL ROUTINE lex$getsym : NOVALUE = 		!

!++
! Functional description:
!	This routine filters tokens between the scanner and the
!	Parser.  There is a class of tokens which are
!	part of the BLISS "meta" language. These
!	tokens control the flow of lexemes
!	to the parser, and include certain forms of macros,
!	and compile time conditionals (%IF, for example).
!	Since the parser never "sees" the tokens controlling
!	the stream of lexemes to it, and since these are part
!	of the BLISS program, they have to be formatted by
!	a module outside of the parser. This is that module.
!	This module has responsibility for formatting comments
!	and compile time conditionals.
!
! Formal parameters:
!	None
!
! Implicit inputs:
!	token - output of scanner
!
! Implicit outputs:
!	token
!
! Completion codes:
!	Returns eof$_code on end of file
!
! Side effects:
!	Token is modified if it is a name known to BLISS, and is
!	meaningful to the formatter.
!--

!<BLF/page>
    BEGIN

    IF .cur_lex LEQ .end_lex			! Check for synonym generation
    THEN
	BEGIN
!	token [tok_cp] = CH$PTR (syn_list [.index, syn_name]);
	tok = token [tok_type] = null_symbol;

	IF .cur_lex EQL .end_lex
	THEN
	! Check for previous return of the synonym name
	    BEGIN

	    IF .match
	    THEN 				! Last chance to output the name
		BEGIN
		token [tok_len] = .syn_list [.index, lth_syn_name];	!
		out$stoks ();			! output it
		match = false;			! Indicate name has been output
		END;

	    END
	ELSE
	    BEGIN
	    ! return a lexeme from current synonym list.
	    tok = token [tok_type] = .lex_list [.cur_lex];
	    token [tok_len] = 0;

	    IF .match AND .tok EQL special_token
	    THEN
		BEGIN
		token [tok_len] = .syn_list [.index, lth_syn_name];	!
		tok = token [tok_type] = null_symbol;
		out$stoks ();			! output it.
		match = false;
		END

	    END;

	cur_lex = .cur_lex + 1;
	END
    ELSE
!<BLF/page>
	BEGIN

	LOCAL
	    pquote;				! flag; true if %QUOTE found

	pquote = false;

	WHILE .tok NEQ s_end_of_file DO
	    BEGIN				! Loop
	    scn$getsym (true);			! 'True' implies from input file

	    SELECTONE .token [tok_type] OF
		SET

		[s_name] :
		    BEGIN

		    IF .last_tok EQL s_name	! Assure a space between names
		    THEN
			out$space (1);

		    lookup ();			! Look up reserved word
		    last_tok = s_name;		! Ignore refinement of type
		    END;

		[s_numeric] :
		    BEGIN

		    !+
		    ! Ensure numbers not merged with names, etc.
		    !-

		    IF .last_tok EQL s_name	!
		    THEN
			out$space (1);

		    last_tok = s_name;
		    END;

		[s_newline] :
		    ! Leave last_tok alone
		;

		[start_embedded] : 		! %(
		    BEGIN

		    IF .last_tok EQL s_name THEN out$space (1);

		    last_tok = null_symbol;
		    END;

		[OTHERWISE] :
		    last_tok = null_symbol;	! Anything else can be juxtaposed
		TES;

	    SELECTONE .token [tok_type] OF
		SET

		[s_percent_if] :
		    BEGIN			! Format %IF
		    in_pc_if = .in_pc_if + 1;
		    out$skip (1);

		    IF prs$_mac_level () EQL 0
		    THEN
			out$ntbreak ()		! line break
		    ELSE
			out$break ();

		    out$tok ();			! Move %IF to buffer
		    out$space (1);
		    lex$getsym ();		! start of conditional expression
		    prs$expression (s_lparen);

		    IF .tok NEQ s_percent_then
		    THEN
			utl$error (er_pthen)
		    ELSE
			IF prs$_mac_level () EQL 0
			THEN
			    out$ntbreak ()	! line break
			ELSE
			    out$break ();

		    out$tok ();			! Move %THEN to buffer
		    IF prs$_mac_level () GTR 0 THEN out$indent (1);
		    out$force ();
		    END;

		[s_percent_else] :
		    BEGIN

		    IF prs$_mac_level () EQL 0
		    THEN
			BEGIN
			out$ntbreak ();		! line break
			END
		    ELSE
			BEGIN
			out$indent (-1);
			out$break ();
			END;

		    out$tok ();
		    IF prs$_mac_level () GTR 0 THEN out$indent (+1);
		    out$force ();
		    END;

		[s_percent_fi] :
		    BEGIN
		    in_pc_if = .in_pc_if - 1;

		    IF prs$_mac_level () EQL 0
		    THEN
			BEGIN
			out$ntbreak ();		! line break
			END
		    ELSE
			BEGIN
			out$indent (-1);
			out$break ();
			END;

		    out$tok ();
		    out$pend_skip (1);
		    out$force ();
		    END;

		[s_p_title, s_p_subtitle] :
		    BEGIN

		    LOCAL
			type;

		    out$ntbreak ();		! put on newline
		    type = .token [tok_type];
		    out$eject (.type);
		    out$tok ();			! "%TITLE" or "%SBTTL"
		    scn$getsym ();		! Get quoted string
		    out$stoks ();		! " '...' "

		    IF .type EQL s_p_title
		    THEN
			lst$title (.token [tok_len], .token [tok_cp])
		    ELSE
			lst$subtitle (.token [tok_len], .token [tok_cp]);

		    out$force ();
		    END;

		[s_p_compiler,s_empty] :			! TT  12-Oct-81
		    BEGIN
		    out$stoks ();		! "%BLISS16", etc.
		    lex$getsym ();
		    prs$block ();
		    EXITLOOP;
		    END;

		[s_p_quote] :
		    BEGIN			! Format %QUOTE
		    out$stoks ();		! " %QUOTE "
		    pquote = true;		! Ignore type of next token
		    END;

		[start_embedded] :
		    BEGIN
		    out$tok ();
		    lst$dot (false);		! Stop dotting listing
		    END;

		[mid_embedded] :
		    BEGIN
		    lst$dot (false);
		    out$tok ();			! Comment line
! The no-tab-break here is needed to prevent embedded comments
! from growing by 4 spaces each time the file is processed.
		    out$ntbreak ();
		    END;

		[end_embedded] :
		    BEGIN
		    out$tok ();
		    lst$dot (true);		! Resume dotting listing
		    END;

		[full_line_com] :
		    BEGIN

		    LOCAL			! Used in case conversion
			ch,
			lcp,
			tcp,
			command:	vector [CH$ALLOCATION (6)];

		    IF CH$NEQ (9, .token [tok_cp], 	!
			    9, CH$PTR (UPLIT('!!ERROR!!')))
		    THEN
			BEGIN

			IF CH$EQL (3, .token [tok_cp], 	!
				3, CH$PTR (UPLIT('!++')))
			THEN
			    out$skip (1);	! Pre- block skip

			out$ntbreak ();
			out$tok ();		! Full-line COMMENT
			out$break ();

			!+
			! Look for special control comments of the form
			! <BLF/...>
			! Begin by converting to upper case.
			!-

			tcp = .token [tok_cp];
			lcp = CH$PTR (comment);

			INCR n FROM 1 TO .token [tok_len] DO
			    BEGIN
			    ch = CH$RCHAR_A (tcp);

			    IF .ch GEQ %C'a' AND .ch LEQ %C'z' THEN ch = .ch XOR casebit;

			    CH$WCHAR_A (.ch, lcp);
			    END;


			tcp = CH$PTR (command);
			lcp = CH$PTR (comment);

			INCR i from 1 to 6 DO
			    BEGIN
			    ch = CH$RCHAR_A (lcp);
	
			    IF .ch GEQ %C'a' AND .ch LEQ %C'z'
			    THEN
				ch = .ch XOR casebit;

			    CH$WCHAR_A (.ch, tcp);
			    END;

			IF CH$EQL (6, CH$PTR (command), 	!
				6, CH$PTR (UPLIT('!<BLF/')))
			THEN 			! Analyse the rest of the line.
			    ctl$command (CH$PTR (comment));

			CH$FILL (%C' ', 20, CH$PTR (comment));	! Erase last comment

			IF CH$EQL (3, .token [tok_cp], 	!
				3, CH$PTR (UPLIT('!--'))) OR 	!
			    CH$EQL (3, .token [tok_cp], 	!
				3, CH$PTR (UPLIT('!__')))
			THEN
			    out$skip (1);	! Post-block skip

			END;

		    END;

		[start_block_com, mid_block_com, end_block_com] :
		    BEGIN

		    IF .token [tok_type] EQL start_block_com THEN out$skip (1);

		    out$comment ();
		    out$break ();

		    IF .token [tok_type] EQL end_block_com THEN out$skip (1);

		    END;

		[remark] :
		    (out$force (); out$remark (); );

		[s_newpage] :
		;				! Delete formfeeds

		[s_newline] :
		;				! Ignore end-of-line lexemes.

		[s_eludom] :
		    BEGIN
		    out$break ();
		    out$nit ();			! Recover from all errors in indentation
		    EXITLOOP;
		    END;

		[s_end_of_file] :
		    BEGIN
		    ! There may be comments and such left...
		    out$ntbreak ();
		    EXITLOOP;
		    END;

		[OTHERWISE] :
		    EXITLOOP;
		TES;

	    END;					! Loop

!+
! If not processing macros, the sequence "%QUOTE %" must be ignored.
! This is done by converting a percent that follows "%QUOTE" to a
! comma.
!-

	IF .pquote AND 				!
	    NOT ctl$switch (sw_macro) AND 	!
	    .token [tok_type] EQL s_percent
	THEN
	    tok = s_comma			! Ignore token type
	ELSE
	    tok = .token [tok_type];

	IF ctl$switch (sw_debug) THEN out$print ();

	END;					! End of routine 'LEX$GETSYM'

    END;

GLOBAL ROUTINE lex$init : NOVALUE = 		!

!++
! Functional description:
!	This routine initializes own data for this module, in particular
!	the tables associated with the SYNONYM facility.
!
! Formal parameters:
!	None
!
! Implicit inputs:
!	None
!
! Implicit outputs:
!	None
!
! Routine value:
!	None
!
! Side effects:
!	None
!
!--

    BEGIN

    INCR i FROM 0 TO syn_table_size - 1 DO
	BEGIN
	! Clear out the synonym tables...
	syn_list [.i, first_lex_syn] = 		!
	syn_list [.i, final_lex_syn] = 0;
	CH$FILL (%C' ', syn_name_len, 		!
	    CH$PTR (syn_list [.i, syn_name]));
	END;

    lex_index = syn_index = 0;			! Ignore previous synonym definitions
    in_pc_if = 0;				! Zero count of %IF blocks
    END;					! End of routine 'lex$init'

ROUTINE lookup : NOVALUE = 			!

!++
! Functional description:
!	Identifies those words meaningful to the formatter.
!
! Formal parameters:
!	None
!
! Implicit inputs:
!	None
!
! Implicit outputs:
!	None
!
! Routine value:
!	None
!
! Side effects:
!	The input text may be converted to upper or to lower case.
!--

    BEGIN

    LITERAL
	max_sym_len = 31;

    LOCAL
	i,					! search index
	hi,					! upper range  on binary search
	lo,					! lower range on binary search
	lptr,					! pointer to 'locase'
	uptr,					! pointer to 'upcase'
	ch,					! storage for a character
	iptr,					! pointer to input string
	locase : VECTOR [CH$ALLOCATION (max_sym_len)],	! Storage for lower case string
	upcase : VECTOR [CH$ALLOCATION (max_sym_len)];	! Storage for upper case string

!<BLF/page>
!<BLF/noformat>
!++
!  The following table is a complete list of all BLISS keywords,
!  (with the exception of some machine-specific BUILTIN function names)
!  in alphabetical (ASCII) sequence, with the associated lexeme type.
!  Lexemes which have no effect on the formatter are included (with
!  type = s_name) to permit automatic upper- lower- case
!  conversions to take place. As new keywords are added to the language,
!  they should be added to the table at the appropriate place.
!--
    BIND
	rnames = PLIT(				!
	s_name,		scnt('$CODE$'),		!
	s_name,		scnt('$COUNT'),		!
	s_name,		scnt('$GLOBAL$'),	!
	s_name,		scnt('$LENGTH'),	!
	s_name,		scnt('$NAME'),		!
	s_name,		scnt('$OWN$'),		!
	s_name,		scnt('$PLIT$'),		!
	s_name,		scnt('$QUOTE'),		!
	s_name,		scnt('$REMAINING'),	!
	s_name,		scnt('$STRING'),	!
	s_name,		scnt('$UNQUOTE'),	!
	s_name,		scnt('%ALLOCATION'),	!
	s_name,		scnt('%ASCIC'),		!
	s_name,		scnt('%ASCID'),		!
	s_name,		scnt('%ASCII'),		!
	s_name,		scnt('%ASCIZ'),		!
	s_empty,	scnt('%ASSIGN'),	!
	s_name,		scnt('%B'),		!
	s_name,		scnt('%BLISS'),		!
	s_p_compiler,	scnt('%BLISS16'),	!
	s_p_compiler,	scnt('%BLISS32'),	!
	s_p_compiler,	scnt('%BLISS36'),	!
	s_name,		scnt('%BPADDR'),	!
	s_name,		scnt('%BPUNIT'),	!
	s_name,		scnt('%BPVAL'),		!
	s_name,		scnt('%C'),		!
	s_name,		scnt('%CHAR'),		!
	s_name,		scnt('%CHARCOUNT'),	!
	s_name,		scnt('%COUNT'),		!
	s_empty,	scnt('%CTCE'),		!
	s_name,		scnt('%D'),		!
	s_name,		scnt('%DECIMAL'),	!
	s_name,		scnt('%DECLARED'),	!
	s_name,		scnt('%E'),		!
	s_percent_else,	scnt('%ELSE'),		!
	s_empty,	scnt('%ERROR'),		!
	s_empty,	scnt('%ERRORMACRO'),	!
	s_name,		scnt('%EXACTSTRING'),	!
	s_name,		scnt('%EXITITERATION'),	!
	s_name,		scnt('%EXITMACRO'),	!
	s_name,		scnt('%EXPAND'),	!
	s_name,		scnt('%EXPLODE'),	!
	s_percent_fi,	scnt('%FI'),		!
	s_name,		scnt('%FIELDEXPAND'),	!
	s_name,		scnt('%IDENTICAL'),	!
	s_percent_if,	scnt('%IF'),		!
	s_empty,	scnt('%INFORM'),	!
	s_empty,	scnt('%ISSTRING'),	!
	s_name,		scnt('%LENGTH'),	!
	s_empty,	scnt('%LTCE'),		!
	s_empty,	scnt('%MESSAGE'),	!
	s_name,		scnt('%NAME'),		!
	s_name,		scnt('%NBITS'),		!
	s_name,		scnt('%NBITSU'),	!
	s_name,		scnt('%NULL'),		!
	s_name,		scnt('%NUMBER'),	!
	s_name,		scnt('%O'),		!
	s_name,		scnt('%P'),		!
	s_EMPTY,	scnt('%PRINT'),		!
	s_p_quote,	scnt('%QUOTE'),		!
	s_name,		scnt('%RAD50_10'),	!
	s_name,		scnt('%RAD50_11'),	!
	s_name,		scnt('%REF'),		!
	s_name,		scnt('%REQUIRE'),	!	! TT  20-Oct-81
	s_name,		scnt('%REMAINING'),	!
	s_name,		scnt('%REMOVE'),	!
	s_p_subtitle,	scnt('%SBTTL'),		!
	s_name,		scnt('%SIXBIT'),	!
	s_name,		scnt('%SIZE'),		!
	s_name,		scnt('%STRING'),	!
	s_name,		scnt('%SWITCHES'),	!
	s_percent_then,	scnt('%THEN'),		!
	s_p_title,	scnt('%TITLE'),		!
	s_name,		scnt('%UNQUOTE'),	!
	s_name,		scnt('%UPVAL'),		!
	s_name,		scnt('%VARIANT'),	!
	s_EMPTY,	scnt('%WARN'),		!
	s_name,		scnt('%X'),		!
	s_name,		scnt('ABS'),		!
	s_name,		scnt('ABSOLUTE'),	!
	s_name,		scnt('ACTUALCOUNT'),	!
	s_name,		scnt('ACTUALPARAMETER'),!
	s_name,		scnt('ACTUALTYPE'),	!
	s_name,		scnt('ADDD'),		!
	s_name,		scnt('ADDF'),		!
	s_name,		scnt('ADDG'),		!
	s_name,		scnt('ADDH'),		!
	s_name,		scnt('ADDM'),		!
	s_name,		scnt('ADDRESSING_MODE'),!
	s_name,		scnt('ALIGN'),		!
	s_name,		scnt('ALWAYS'),		!
	s_and,		scnt('AND'),		!
	s_name,		scnt('AP'),		!
	s_name,		scnt('ARGPTR'),		!
	s_name,		scnt('ASHP'),		!
	s_name,		scnt('ASSEMBLY'),	!
	s_begin,	scnt('BEGIN'),		!
	s_name,		scnt('BICPSW'),		!
	s_name,		scnt('BINARY'),		!
	s_bind,		scnt('BIND'),		!
	s_name,		scnt('BISPSW'),		!
	s_name,		scnt('BIT'),		!
	s_name,		scnt('BITVECTOR'),	!
	s_name,		scnt('BLISS'),		!
	s_name,		scnt('BLISS10'),	!
	s_name,		scnt('BLISS10_OTS'),	!
	s_name,		scnt('BLISS10_REGS'),	!
	s_name,		scnt('BLISS16'),	!
	s_name,		scnt('BLISS32'),	!
	s_name,		scnt('BLISS36'),	!
	s_name,		scnt('BLISS36C'),	!
	s_name,		scnt('BLISS36C_OTS'),	!
	s_name,		scnt('BLOCK'),		!
	s_name,		scnt('BLOCKVECTOR'),	!
	s_builtin,	scnt('BUILTIN'),	!
	s_by,		scnt('BY'),		!
	s_byte,		scnt('BYTE'),		!
	s_name,		scnt('CALL'),		!
	s_name,		scnt('CALLG'),		!
	s_case,		scnt('CASE'),		!
	s_name,		scnt('CAVEAT'),		!
	s_name,		scnt('CH$ALLOCATION'),	!
	s_name,		scnt('CH$A_RCHAR'),	!
	s_name,		scnt('CH$A_WCHAR'),	!
	s_name,		scnt('CH$COMPARE'),	!
	s_name,		scnt('CH$COPY'),	!
	s_name,		scnt('CH$DIFF'),	!
	s_name,		scnt('CH$EQL'),		!
	s_name,		scnt('CH$FAIL'),	!
	s_name,		scnt('CH$FILL'),	!
	s_name,		scnt('CH$FIND_CH'),	!
	s_name,		scnt('CH$FIND_NOT_CH'),	!
	s_name,		scnt('CH$FIND_SUB'),	!
	s_name,		scnt('CH$GEQ'),		!
	s_name,		scnt('CH$GTR'),		!
	s_name,		scnt('CH$LEQ'),		!
	s_name,		scnt('CH$LSS'),		!
	s_name,		scnt('CH$MOVE'),	!
	s_name,		scnt('CH$NEQ'),		!
	s_name,		scnt('CH$PLUS'),	!
	s_name,		scnt('CH$PTR'),		!
	s_name,		scnt('CH$RCHAR'),	!
	s_name,		scnt('CH$RCHAR_A'),	!
	s_name,		scnt('CH$SIZE'),	!
	s_name,		scnt('CH$TRANSLATE'),	!
	s_plit,		scnt('CH$TRANSTABLE'),	!
	s_name,		scnt('CH$WCHAR'),	!
	s_name,		scnt('CH$WCHAR_A'),	!
	s_name,		scnt('CLEARSTACK'),	!
	s_name,		scnt('CMPC3'),		!
	s_name,		scnt('CMPC5'),		!
	s_name,		scnt('CMPD'),		!
	s_name,		scnt('CMPF'),		!
	s_name,		scnt('CMPG'),		!
	s_name,		scnt('CMPH'),		!
	s_name,		scnt('CMPM'),		!
	s_name,		scnt('CODE'),		!
	s_codecomment,	scnt('CODECOMMENT'),	!
	s_name,		scnt('COMMENTARY'),	!
	s_compiletime,	scnt('COMPILETIME'),	!
	s_name,		scnt('CONCATENATE'),	!
	s_name,		scnt('CRC'),		!
	s_name,		scnt('CVTDF'),		!
	s_name,		scnt('CVTDI'),		!
	s_name,		scnt('CVTFD'),		!
	s_name,		scnt('CVTFG'),		!
	s_name,		scnt('CVTFH'),		!
	s_name,		scnt('CVTFI'),		!
	s_name,		scnt('CVTGF'),		!
	s_name,		scnt('CVTGH'),		!
	s_name,		scnt('CVTGL'),		!
	s_name,		scnt('CVTHF'),		!
	s_name,		scnt('CVTHG'),		!
	s_name,		scnt('CVTHL'),		!
	s_name,		scnt('CVTID'),		!
	s_name,		scnt('CVTIF'),		!
	s_name,		scnt('CVTLG'),		!
	s_name,		scnt('CVTLH'),		!
	s_name,		scnt('CVTRGH'),		!
	s_name,		scnt('CVTRGL'),		!
	s_name,		scnt('DEBUG'),		!
	s_decr,		scnt('DECR'),		!
	s_decra,	scnt('DECRA'),		!
	s_decru,	scnt('DECRU'),		!
	s_name,		scnt('DIVD'),		!
	s_name,		scnt('DIVF'),		!
	s_name,		scnt('DIVH'),		!
	s_do,		scnt('DO'),		!
	s_name,		scnt('EDIV'),		!
	s_name,		scnt('EIS'),		!
	s_else,		scnt('ELSE'),		!
	s_eludom,	scnt('ELUDOM'),		!
	s_name,		scnt('EMT'),		!
	s_name,		scnt('EMUL'),		!
	s_enable,	scnt('ENABLE'),		!
	s_end,		scnt('END'),		!
	s_name,		scnt('ENTRY'),		!
	s_name,		scnt('ENVIRONMENT'),	!
	s_eql,		scnt('EQL'),		!
	s_eqla,		scnt('EQLA'),		!
	s_eqlu,		scnt('EQLU'),		!
	s_eqv,		scnt('EQV'),		!
	s_name,		scnt('ERRS'),		!
	s_name,		scnt('EXECUTE'),	!
	s_exitloop,	scnt('EXITLOOP'),	!
	s_name,		scnt('EXPAND'),		!
	s_name,		scnt('EXTENDED'),	!
	s_external,	scnt('EXTERNAL'),	!
	s_name,		scnt('F10'),		!
	s_name,		scnt('FFC'),		!
	s_name,		scnt('FFS'),		!
	s_field,	scnt('FIELD'),		!
	s_name,		scnt('FIRSTONE'),	!
	s_name,		scnt('FORTRAN'),	!
	s_name,		scnt('FORTRAN_FUNC'),	!
	s_name,		scnt('FORTRAN_SUB'),	!
	s_forward,	scnt('FORWARD'),	!
	s_name,		scnt('FP'),		!
	s_name,		scnt('FRAMETYPE'),	!
	s_from,		scnt('FROM'),		!
	s_name,		scnt('GENERAL'),	!
	s_geq,		scnt('GEQ'),		!
	s_geqa,		scnt('GEQA'),		!
	s_gequ,		scnt('GEQU'),		!
	s_global,	scnt('GLOBAL'),		!
	s_gtr,		scnt('GTR'),		!
	s_gtra,		scnt('GTRA'),		!
	s_gtru,		scnt('GTRU'),		!
	s_name,		scnt('HALT'),		!
	s_name,		scnt('IDENT'),		!
	s_if,		scnt('IF'),		!
	s_incr,		scnt('INCR'),		!
	s_incra,	scnt('INCRA'),		!
	s_incru,	scnt('INCRU'),		!
	s_name,		scnt('INDEX'),		!
	s_initial,	scnt('INITIAL'),	!
	s_name,		scnt('INRANGE'),	!
	s_name,		scnt('INSQUE'),		!
	s_name,		scnt('INTERRUPT'),	!
	s_name,		scnt('IOPAGE'),		!
	s_name,		scnt('IOT'),		!
	s_name,		scnt('JSB'),		!
	s_name,		scnt('JSR'),		! BLISS-16
	s_name,		scnt('JSYS'),		! BLISS-36
	s_keywordmacro,	scnt('KEYWORDMACRO'),	!
	s_label,	scnt('LABEL'),		!
	s_name,		scnt('LANGUAGE'),	!
	s_leave,	scnt('LEAVE'),		!
	s_leq,		scnt('LEQ'),		!
	s_leqa,		scnt('LEQA'),		!
	s_lequ,		scnt('LEQU'),		!
	s_library,	scnt('LIBRARY'),	!
	s_linkage,	scnt('LINKAGE'),	!
	s_name,		scnt('LINKAGE_REGS'),	!
	s_name,		scnt('LIST'),		!
	s_literal,	scnt('LITERAL'),	!
	s_local,	scnt('LOCAL'),		!
	s_name,		scnt('LOCC'),		!
	s_long,		scnt('LONG'),		!
	s_name,		scnt('LONG_RELATIVE'),	!
	s_lss,		scnt('LSS'),		!
	s_lssa,		scnt('LSSA'),		!
	s_lssu,		scnt('LSSU'),		!
	s_macro,	scnt('MACRO'),		!
	s_name,		scnt('MAIN'),		!
	s_map,		scnt('MAP'),		!
	s_name,		scnt('MATCHC'),		!
	s_name,		scnt('MAX'),		!
	s_name,		scnt('MAXA'),		!
	s_name,		scnt('MAXU'),		!
	s_name,		scnt('MFPR'),		!
	s_name,		scnt('MIN'),		!
	s_name,		scnt('MINA'),		!
	s_name,		scnt('MINU'),		!
	s_mod,		scnt('MOD'),		!
	s_module,	scnt('MODULE'),		!
	s_name,		scnt('MOVC3'),		!
	s_name,		scnt('MOVC5'),		!
	s_name,		scnt('MOVPSL'),		!
	s_name,		scnt('MOVTC'),		!
	s_name,		scnt('MOVPSL'),		! BLISS-32
	s_name,		scnt('MOVTUC'),		! BLISS-32
	s_name,		scnt('MPTR'),		!
	s_name,		scnt('MULD'),		!
	s_name,		scnt('MULF'),		!
	s_name,		scnt('MULG'),		!
	s_name,		scnt('MULH'),		!
	s_neq,		scnt('NEQ'),		!
	s_neqa,		scnt('NEQA'),		!
	s_nequ,		scnt('NEQU'),		!
	s_name,		scnt('NOASSEMBLY'),	!
	s_name,		scnt('NOBINARY'),	!
	s_name,		scnt('NOCODE'),		!
	s_name,		scnt('NOCOMMENTARY'),	!
	s_name,		scnt('NODEBUG'),	!
	s_name,		scnt('NODEFAULT'),	!	! TT  20-Oct-81
	s_name,		scnt('NOEIS'),		! BLISS-16
	s_name,		scnt('NOERRS'),		!
	s_name,		scnt('NOEXECUTE'),	!
	s_name,		scnt('NOEXPAND'),	!
	s_name,		scnt('NONEXTERNAL'),	!
	s_name,		scnt('NOOBJECT'),	!
	s_name,		scnt('NOOPTIMIZE'),	!
	s_name,		scnt('NOPIC'),		!
	s_name,		scnt('NOPRESERVE'),	!
	s_name,		scnt('NOREAD'),		!
	s_name,		scnt('NOREQUIRE'),	!
	s_name,		scnt('NOSAFE'),		!
	s_name,		scnt('NOSHARE'),	!
	s_name,		scnt('NOSOURCE'),	!
	s_name,		scnt('NOSYMBOLIC'),	!
	s_not,		scnt('NOT'),		!
	s_name,		scnt('NOTRACE'),	!
	s_name,		scnt('NOTUSED'),	!
	s_name,		scnt('NOUNAMES'),	!
	s_name,		scnt('NOVALUE'),	!
	s_name,		scnt('NOWRITE'),	!
	s_name,		scnt('NOZIP'),		!
	s_name,		scnt('NULLPARAMETER'),	!
	s_name,		scnt('OBJECT'),		!
	s_of,		scnt('OF'),		!
	s_name,		scnt('OPTIMIZE'),	!
	s_name,		scnt('OPTLEVEL'),	!
	s_or,		scnt('OR'),		!
	s_name,		scnt('OTHERWISE'),	!
	s_name,		scnt('OTS'),		!
	s_name,		scnt('OUTRANGE'),	!
	s_name,		scnt('OVERLAY'),	!
	s_own,		scnt('OWN'),		!
	s_name,		scnt('PC'),		!
	s_name,		scnt('PIC'),		!
	s_plit,		scnt('PLIT'),		!
	s_name,		scnt('POINT'),		!
	s_name,		scnt('PORTAL'),		!
	s_name,		scnt('PRESERVE'),	!
	s_initial,	scnt('PRESET'),		!
	s_name,		scnt('PROBER'),		!
	s_name,		scnt('PROBEW'),		!
	s_psect,	scnt('PSECT'),		!
	s_name,		scnt('PUSHJ'),		!
	s_name,		scnt('R0'),		!
	s_name,		scnt('R1'),		!
	s_name,		scnt('R10'),		!
	s_name,		scnt('R11'),		!
	s_name,		scnt('R2'),		!
	s_name,		scnt('R3'),		!
	s_name,		scnt('R4'),		!
	s_name,		scnt('R5'),		!
	s_name,		scnt('R6'),		!
	s_name,		scnt('R7'),		!
	s_name,		scnt('R8'),		!
	s_name,		scnt('R9'),		!
	s_name,		scnt('READ'),		!
	s_name,		scnt('RECORD'),		!
	s_name,		scnt('REF'),		!
	s_register,	scnt('REGISTER'),	!
	s_name,		scnt('RELATIVE'),	!
	s_name,		scnt('RELOCATABLE'),	!
	s_name,		scnt('REMQUE'),		!
	s_rep,		scnt('REP'),		!
	s_name,		scnt('REPLACEI'),	!
	s_name,		scnt('REPLACEN'),	!
	s_require,	scnt('REQUIRE'),	!
	s_name,		scnt('RESERVE'),	!
	s_name,		scnt('RESOLVED'),	!
	s_return,	scnt('RETURN'),		!
	s_name,		scnt('ROT'),		!
	s_routine,	scnt('ROUTINE'),	!
	s_name,		scnt('RTT'),		!
	s_name,		scnt('SAFE'),		!
	s_select,	scnt('SELECT'),		!
	s_selecta,	scnt('SELECTA'),	!
	s_selectone,	scnt('SELECTONE'),	!
	s_selectonea,	scnt('SELECTONEA'),	!
	s_selectoneu,	scnt('SELECTONEU'),	!
	s_selectu,	scnt('SELECTU'),	!
	s_set,		scnt('SET'),		!
	s_name,		scnt('SETUNWIND'),	!
	s_name,		scnt('SHARE'),		!
	s_name,		scnt('SHOW'),		!
	s_name,		scnt('SIGN'),		!
	s_name,		scnt('SIGNAL'),		!
	s_name,		scnt('SIGNAL_STOP'),	!
	s_name,		scnt('SIGNED'),		!
	s_name,		scnt('SKPC'),		!
	s_name,		scnt('SOURCE'),		!
	s_name,		scnt('SP'),		!
	s_name,		scnt('STACK'),		!
	s_stacklocal,	scnt('STACKLOCAL'),	!
	s_name,		scnt('STANDARD'),	!
	s_name,		scnt('STANDARD_OTS'),	!
	s_structure,	scnt('STRUCTURE'),	!
	s_name,		scnt('SUBD'),		!
	s_name,		scnt('SUBF'),		!
	s_name,		scnt('SUBG'),		!
	s_name,		scnt('SUBH'),		!
	s_name,		scnt('SUBM'),		!
	s_switches,	scnt('SWITCHES'),	!
	s_name,		scnt('SYMBOLIC'),	!
	s_name,		scnt('SYSLOCAL'),	!
	s_tes,		scnt('TES'),		!
	s_name,		scnt('TESTBITCC'),	!
	s_name,		scnt('TESTBITCCI'),	!
	s_name,		scnt('TESTBITCS'),	!
	s_name,		scnt('TESTBITSC'),	!
	s_name,		scnt('TESTBITSS'),	!
	s_name,		scnt('TESTBITSSI'),	!
	s_then,		scnt('THEN'),		!
	s_to,		scnt('TO'),		!
	s_name,		scnt('TOPS10'),		!
	s_name,		scnt('TOPS20'),		!
	s_name,		scnt('TRACE'),		!
	s_name,		scnt('TRAP'),		!
	s_name,		scnt('TYPEPRESENT'),	!
	s_name,		scnt('UNAMES'),		!
	s_undeclare,	scnt('UNDECLARE'),	!
	s_name,		scnt('UNRESOLVED'),	!
	s_name,		scnt('UNSIGNED'),	!
	s_until,	scnt('UNTIL'),		!
	s_uplit,	scnt('UPLIT'),		!
	s_name,		scnt('VECTOR'),		!
	s_name,		scnt('VERSION'),	!
	s_name,		scnt('VOLATILE'),	!
	s_name,		scnt('WEAK'),		!
	s_while,	scnt('WHILE'),		!
	s_with,		scnt('WITH'),		!
	s_word,		scnt('WORD'),		!
	s_name,		scnt('WORD_RELATIVE'),	!
	s_name,		scnt('WRITE'),		!
	s_name,		scnt('XFC'),		!
	s_xor,		scnt('XOR'),		!
	s_name,		scnt('ZIP')		!
	) : VECTOR;
!<BLF/PAGE>
!+
    ! Convert the input identifier to both upper and lower case.
    !-

    iptr = .token [tok_cp];
    lptr = CH$PTR (locase);
    uptr = CH$PTR (upcase);

    INCR i FROM 1 TO MIN (max_sym_len, .token [tok_len]) DO
	BEGIN
	ch = CH$RCHAR_A (iptr);

	SELECTONE .ch OF
	    SET

	    [%C'A' TO %C'Z'] :
		BEGIN
		CH$WCHAR_A (.ch, uptr);
		CH$WCHAR_A (.ch XOR casebit, lptr);
		END;

	    [%C'a' TO %C'z'] :
		BEGIN
		CH$WCHAR_A (.ch, lptr);
		CH$WCHAR_A (.ch XOR casebit, uptr);
		END;

	    [OTHERWISE] :
		BEGIN
		CH$WCHAR_A (.ch, lptr);
		CH$WCHAR_A (.ch, uptr);
		END;
	    TES;

	END;

    !+
    !  Now look up (capitalized) symbol in BLISS keyword table.
    !  (Binary search is used.)
    !-

    lptr = CH$PTR (locase);
    uptr = CH$PTR (upcase);
    lo = 0;
    hi = .plit_count (rnames)/entry_size - 1;

    UNTIL .hi LSS .lo DO
	BEGIN

	LITERAL
	    _lss = -1,
	    _eql = 0,
	    _gtr = +1;

	i = (.hi + .lo)/2;			! Midpoint of rest of table

	!+
	! Compare upper-case input name with BLISS keyword list
	!-

	CASE CH$COMPARE (.token [tok_len], .uptr, 	!
		.rnames [1 + entry_size*.i], 	!
		CH$PTR (.rnames [2 + entry_size*.i]))	!
	FROM _lss TO _gtr OF
	    SET

	    [_lss] :
		hi = .i - 1;

	    [_eql] : 				! Found name in table
		BEGIN
		token [tok_type] = .rnames [entry_size*.i];
		EXITLOOP;
		END;

	    [_gtr] :
		lo = .i + 1;
	    TES;

	END;

    IF .hi LSS .lo
    THEN 					! No match was found, so
    						! it's a user name.

	CASE ctl$switch (sw_user_case) FROM 0 TO 2 OF
	    SET

	    [sw_locase] :
		CH$MOVE (MIN (max_sym_len, .token [tok_len]),	!
		    .lptr,			!
		    .token [tok_cp]);

	    [sw_upcase] :
		CH$MOVE (MIN (max_sym_len, .token [tok_len]),	!
		    .uptr,			!
		    .token [tok_cp]);

	    [sw_nocase] :
		0;				! leave it alone
	    TES

    ELSE

	CASE ctl$switch (sw_key_case) FROM 0 TO 2 OF
	    SET

	    [sw_locase] :
		CH$MOVE (MIN (max_sym_len, .token [tok_len]),	!
		    .lptr,			!
		    .token [tok_cp]);

	    [sw_upcase] :
		CH$MOVE (MIN (max_sym_len, .token [tok_len]),	!
		    .uptr,			!
		    .token [tok_cp]);

	    [sw_nocase] :
		0;				! leave it alone
	    TES;

    match = false;				! Assume not a synonym.

    INCR i FROM 0 TO .syn_index DO

	IF CH$EQL (.token [tok_len], .uptr, 	!
		.syn_list [.i, lth_syn_name], 	!
		CH$PTR (syn_list [.i, syn_name]), 	!
		%C' ')
	THEN
	    BEGIN
	    index = .i;
	    match = true;
	    EXITLOOP;
	    END;

    IF .match
    THEN
	BEGIN
	cur_lex = .syn_list [.index, first_lex_syn];
	end_lex = .syn_list [.index, final_lex_syn];
	token [tok_type] = null_symbol;		! Prevent immediate return of the name
	! Now when LEX$GETSYM is entered, synonym lexemes will be returned
	! until cur_lex catches up to end_lex.
	END;

    END;					! End of routine 'LOOKUP'
%TITLE 'Last page of LEX.BLI'
END						! End of module 'LEX'

ELUDOM