! File:   LEXAN.BLI
!
Module LEXAN =
Begin
!				LEXAN MODULE
!				------------
!
!	THIS MODULE IS THE LEXICAL ANALYZER.  A PRIMARY FUNCTION IS
!	THE HANDLING OF MACRO AND STRUCTURE CREATION AND EXPANSION.
!
!
Require 'Bliss';

! symbol type code to lexeme class code mapping

Own tbl_lexclass	: Vector[26,Byte] Preset(
				[S_UNDECLARE]	= T_SYMBOL,
				[S_LOCAL]	= T_SYMBOL,
				[S_OWN]		= T_SYMBOL,
				[S_REGISTER]	= T_SYMBOL,
				[S_FORMAL]	= T_SYMBOL,
				[S_EXTERNAL]	= T_SYMBOL,
				[S_GLOBAL]	= T_SYMBOL,
				[S_ROUTINE]	= T_SYMBOL,
				[S_GBL_ROUTINE]	= T_SYMBOL,
				[S_FORWARD]	= T_SYMBOL,
				[S_BIND]	= T_SYMBOL,
				[S_LABEL]	= T_SYMBOL,
				[S_LINKAGE]	= T_SYMBOL,
				[S_MACRO]	= T_MACRO,
				[S_SPECIAL]	= T_SYMBOL,
				[S_MACRO_ARG]	= T_MACRO_ARG,
				[S_LEX_FUNC]	= T_LEX_FUNC,
				[S_LEX_QUOTE]	= T_LEX_QUOTE,
				[S_LEX_COND]	= T_LEX_COND,
				[S_STRUCT_ARG]	= T_SYMBOL,
				[S_STRUCTURE]	= T_SYMBOL);

! stack a lexeme onto the future lexeme stack

Global Routine PushLexeme(C,S,D) : Novalue =
Begin
    Local
	P		: Ref GT;

    p = mac_stack[.mac_index];
    p[lex_delim] = .d;
    p[lex_type]  = .c;
    p[lex_addr]  = .s;
    p[lex_attr]  = 0;
    mac_index = .mac_index + 1
End;

! read the next atom from the current source file

Routine FILETAKE : Novalue =
Begin
    Local
	c,s,d;

    c = SKAN(s);
    If .c Eql T_DELIMITER Then
	Begin
	d = .s;
	s = 0;
	pos_del = .pos_atom
	End
    Else
	Begin
	d = 0;
	pos_sym = .pos_atom
	End;
    PushLexeme(.c,.s,.d)
End;

! read the next atom from the current source stream
!
! returns TRUE if the end of stream is reached, otherwise FALSE

Routine STRMTAKE =
Begin
    Local
	p		: Ref GT;

! loop until we actually get something

    While .mac_index Eql 0 Do
	Begin

! test for a previously terminated macro

	If .mac_v_eos Then
	    Return TRUE;

! test for end of stream

	mac_v_eos = stream_test_eof();
	If .mac_v_eos Then
	    Return TRUE;

! get an atom from the stream

	p = stream_next();

! stack the delimiter, if any

	If .p[lex_delim] Neq 0 Then
	    PushLexeme(T_DELIMITER,0,.p[lex_delim]);

! stack the symbol, if any

	If .p[lex_type] Neq T_DELIMITER Then
	    PushLexeme(.p[lex_type],.p[lex_addr],0)
	End;
    Return FALSE
End;

!
! CHANGE THE UNDECLARED SYMBOL IN SYM TO A 'DECLARED' EXTERNAL SYMBOL,
! AND COMPLAIN TO THE PROGRAMMER.
!
Routine UNDCLTOLEX(S : Ref GT) =
Begin
    Local
	P		: Ref GT;

    P = STINSERT(.S[st_name],S_EXTERNAL,0);
    P[st_var_size]    = 2;
    P[gt_pos]         = 0;
    P[gt_len]         = 16;
    P[st_v_no_acts]   = TRUE;
    P[st_var_actuals] = .sym_vector;
    P[st_var_linkage] = .sym_bliss;
    post_external(0,2,.P);
    P[st_v_unlim_acts] = TRUE;
    If Not .ERRLEVEL Then
	WARNEM(.pos_sym,B11$_IDENT_UNDECLARED);
    Return .p
End;

! change a string lexeme to a literal lexeme

Routine STRINGTOLEX(S : Ref GT) =
Begin
    Local
	N		: Integer;

    If .S[tx_size] Gtr 1 Then
	WARNEM(.pos_atom,B11$_LONG_STRING);
    FREESTRING(.SYM);
    N = (If .S[tx_size] Gtr 0 Then .S[tx_data] Else 0);
    FreeNode(.s);
    Return MakeLit(.N)
End;

! read the next symbol or delimiter

Global Routine SCANFOR(SYMORDEL : Boolean, QUOTELEVEL : Integer) : Novalue =
Begin
    Local
	K		: Integer,
	P		: Ref GT,
	S		: Ref ST;

! loop until we get something

    While TRUE Do
	Begin

! fill the lexeme stack if empty

	While .mac_index Eql 0 Do
	    If .mac_type Eql SRC_FILE Then
		FILETAKE()
	    Else If STRMTAKE() Then
		macro_finis();

! pop off a lexeme

	mac_index = .mac_index - 1;
	P = mac_stack[.mac_index];

! pass quote flags to the lexeme

	If .flg_quoted Then
	    Begin
	    p[lex_v_quote] = TRUE;
	    flg_quoted = FALSE
	    End;
	If .flg_unquote Then
	    Begin
	    p[lex_v_unquote] = TRUE;
	    flg_unquote = FALSE
	    End;

! handle binding of names and symbols

	If .p[lex_type] Eql T_NAME Or .p[lex_type] Eql T_SYMBOL Then
	    Begin

! get the symbol and its lexical class

	    s = .p[lex_addr];
	    If .p[lex_type] Eql T_NAME Then
		s = .s[nt_symb];
	    If .s Neqa 0 Then
		k = .tbl_lexclass[.s[st_code]]
	    Else
		k = T_NAME;

! bind the name to its symbol unless quoted or its class is
! above the quote level.

	    If Not .p[lex_v_quote] And
			(.quotelevel Lss .k Or .p[lex_v_expand]) And
			.s Neqa 0 Then
		Begin
		p[lex_type] = .k;
		p[lex_addr] = .s
		End;

! bind the name but suppress expansion if $UNQUOTE

	    If .p[lex_v_unquote] And .k Neq T_NAME Then
		Begin
		p[lex_type] = T_SYMBOL;
		p[lex_addr] = .s
		End;

! unbind the name if a macro formal.  we do this because we do
! not want the argument to be evaluated.  this is because the only
! time we would see a macro formal name is within the definition of
! a macro.  SMACRO will change the name to a macro formal lexeme
! which does not go through this path.

	    If .k Eql T_MACRO_ARG Then
		Begin
		p[lex_type] = T_NAME;
		p[lex_addr] = .s[st_name]
		End
	    End;

! perform expansions

	s = .p[lex_addr];
	Case .p[lex_type] From 0 To T_MACRO_ARG Of Set
	    [Inrange,Outrange]:
		Exitloop;

	    [T_MACRO]:
		macro_expand_macro(.S,.SYMORDEL);

	    [T_STRUCT_ARG]:
		struct_expand_formal(.S);

	    [T_MACRO_ARG]:
		Begin

! we pass on any quoting to the argument itself since it did not
! apply to the macro formal lexeme.

		flg_quoted  = .p[lex_v_quote];
		flg_unquote = .p[lex_v_unquote];
		flg_expand  = .p[lex_v_expand];
		macro_expand_formal(.S)
		End;

	    [T_LEX_COND]:
		lex_conditional(.S);

	    [T_LEX_FUNC]:
		lex_function(.S);

	    [T_LEX_QUOTE]:
		lex_quote(.S)
	Tes
	End;

! if a symbol was wanted

    If .SYMORDEL Then
	If .p[lex_type] Neq T_DELIMITER Then
	    Begin
	    SYM = .p[lex_addr];
	    Case .p[lex_type] From T_LITERAL To T_SYMBOL Of Set
		[Inrange,OutRange]:
		    PUNT(666);

		[T_LITERAL]:
		    SYM = MakeLit(.SYM);

		[T_NODE]:
		    0;

		[T_SYMBOL,T_NAME]:
		    Begin
		    If .QUOTELEVEL Eql QL_NAME Then
			Begin
			If .p[lex_type] Eql T_SYMBOL Then
			    SYM = .SYM[st_name]
			End
		    Else If .QUOTELEVEL Lss QL_NAME Then
			Begin
			If .p[lex_type] Eql T_NAME Then
			    If .SYM[nt_symb] Neqa 0 Then
				SYM = .SYM[nt_symb]
			    Else
				SYM = UNDCLTOLEX(.SYM);
			If .SYM[st_code] Eql S_UNDECLARE Then
			    SYM = UNDCLTOLEX(.SYM[st_name]);
			If .SYM[gt_code] Eql S_LITERAL Then
			    SYM = MakeLit(.SYM[gt_disp])
			End
		    End;

		[T_STRING]:
		    If .QUOTELEVEL Lss QL_STRING Then
			SYM = STRINGTOLEX(.SYM)
	    Tes;

! place symbols in variable wrappers

	    If .QUOTELEVEL Lss QL_NAME And .SYM[gt_type] Eql T_SYMBOL Then
		SYM = MakeVar(.SYM);
	    If .p[lex_v_quote] Then
		flg_quote_sym = TRUE
	    End
	Else
	    Begin
	    SYM = NIL;
	    mac_index = .mac_index + 1
	    End
   Else
	If .p[lex_type] Eql T_DELIMITER Then
	    Begin
	    DEL = .p[lex_delim];
	    If .p[lex_v_quote] Then
		flg_quote_del = TRUE;
	    End
	Else
	    Begin
	    DEL = 0;
	    mac_index = .mac_index + 1
	    End
End;

Global Routine RUND(QUOTELEVEL : Integer) : Novalue =
Begin
    Local
	s		: Ref ST;
    Literal
	SYMBOL		= TRUE,
	DELIMITER	= FALSE;

! if the next token is already loaded due to lookahead then
! just return

    If .mac_v_peek Then
	Begin
	mac_v_peek = FALSE;
	Return
	End;

! assume neither the symbol nor the delimiter is to be quoted
! and save the old delimiter.  the old delimiter is used to
! distinguish ambiguous tokens from their context.  e.g.
! '(' is the start of a call after a name or a closing bracket
! and the start of a compound statement otherwise.

    flg_quote_sym = FALSE;
    flg_quote_del = FALSE;
    OLDDEL = .DEL;

! get the symbol

    SCANFOR(SYMBOL,.QUOTELEVEL);

! if macro tracing is on then save the symbol

    If .mac_v_trace Then
	StoreLexeme(trace_buff,SZ_TRACE_BUFF,.SYM,0);

! get the delimiter

     SCANFOR(DELIMITER,.QUOTELEVEL);

! if macro tracing is on then save the delimiter, trying to place
! it with the symbol gotten above.  the only time it could not
! be placed with it is when tracing started after the above symbol
! was gotten.

     If .mac_v_trace Then
	If .trace_buff[strm_size] Eql 0 Then
	    StoreLexeme(trace_buff,SZ_TRACE_BUFF,NIL,.DEL)
	Else
	    Begin
	    Bind X = trace_buff[strm_data(.trace_buff[strm_size]-1)] : GT;
	    X[lex_delim] = .DEL
	    End;

! if inside a macro body then return.  SMACRO wants raw delimiters

    If .flg_macro_body Then
	Return;

! if inside a structure definition then save this symbol and delimiter
! within the defining structure stream.

    If .flg_struct_body Then
	struct_copy();

! note whether this is a reserved word (used to detect attempts
! to re-declare reserved words).

    If .DTPF[.DEL] Neqa 0 Then
	flg_reserved_word = TRUE
    Else
	flg_reserved_word = FALSE;

! save the raw delimiter and cook it.  the cooked delimiter contains
! most of the information about it (class, precedence, index,
! associativity, etc).

    OLDDELI = .DEL;
    DEL = .DT[.DEL];

! check for invalid up-level references to symbols

    If .SYM[gt_type] Eql T_VARIABLE Then
	Begin
	S = .SYM[gt_disp];
	If .S[st_scope] Lss .level_routine And .S[st_v_nouplevel] Then
	    Begin
	    WARNEM(.pos_sym,B11$_ILLEGAL_UPLEVEL);
	    FreeSym();
	    SYM = MakeLit(0)
	    End
	End;

! adjust context sensitive delimiter.
! after a delimiter other than ')', ']', '>', or END

    If .SYM Eql NIL And (.OLDDEL Lss TK_END Or
			.OLDDEL Gtr TK_RBRACKET) Then
	Selectone .DEL Of Set
	    [TK_CALL]:
		Begin
		DEL = TK_LPAREN;

! information for iterative macros.  within a plit, use a ','
! as a separator.  otherwise use a ';', assuming this is a compound
! statement.

		OLDDELI = (If .flg_plit Then ',' Else ';')
		End;
	    [TK_MINUS]:
		DEL = TK_NEG;
	    [TK_ADD]:
		DEL = TK_PLUS
	Tes
    Else

! after a symbol, ')', ']', '>', or END

	Selectone .DEL Of Set
	    [TK_WHILE]: DEL = TK_WHILE2;
	    [TK_UNTIL]: DEL = TK_UNTIL2;
	    [TK_DO]:    DEL = TK_DO2
	Tes
End;

End
Eludom