!<BLF/lowercase_user>
!<BLF/uppercase_key>
MODULE prs1 (					!

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

		IDENT = '6.3-9'
		) =
BEGIN
!++
! Facility: BLISS Formatter
!
! Abstract:
!
!	This module contains routines which format blocks, PLITs,
!	modules and switches.  It also contains the main routine
!	for the parser, 'prs$main'.
!
! Environment: transportable, with Xport
!
!
! Modifications:
!	Nov 1978	SPR04: Weaken 'Block' definition to include [],<>.
!
!
! REVISION HISTORY
!
!	15-Sep-81	TT	Don't call lex if we find s_forward or
!				s_external tokens. If we take the next token
!				here, format screws up and the lines aren't
!				broken properly in LSTING (I believe). This is
!				in routine PRS$BODY.
!
!	28-Sep-81	TT	New syntax allows complete PSECTs within Plits.
!				Change PRS$PLIT_BODY to handle a psect.
!
! END OF REVSISION HISTORY
!--

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

FORWARD ROUTINE
    prs$block : NOVALUE,
    prs$body : NOVALUE,
    prs$main : NOVALUE,
    prs$module : NOVALUE,
    prs$plit_body : NOVALUE,
    prs$switches : NOVALUE;

!
! Include files:
!

REQUIRE 'BLFMAC';				! Defines macros 'lex', 'msg', 'write'

REQUIRE 'SYMCOD';				! Defines symbol property table, 'sym...'

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

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

!
! Macros:
!--

!
! Equated symbols:
!--

LITERAL
    true = 1 EQL 1,
    false = 1 NEQ 1;

!
! Own storage:
!--

!
! External references:
!--

EXTERNAL ROUTINE
    lex$getsym : NOVALUE,
    lst$module : NOVALUE,
    out$break : NOVALUE,
    out$default : NOVALUE,
    out$erase : NOVALUE,
    out$eject : NOVALUE,
    out$force : NOVALUE,
    out$indent : NOVALUE,
    out$mark : NOVALUE,
    out$ntbreak : NOVALUE,
    out$pop_marks : NOVALUE,
    out$push_marks : NOVALUE,
    out$space : NOVALUE,
    out$stoks : NOVALUE,
    out$terminal : NOVALUE,
    out$tok : NOVALUE,
    prs$decl : NOVALUE,				! parse2
    prs$expression : NOVALUE,			! parse3
    prs$set_level : NOVALUE,			! Parse2
    utl$error : NOVALUE;

EXTERNAL
    nolabl,					! true in decl context
    tok,
    token : tok_block,				! One symbol at a time
    symprop : sym_table;

GLOBAL ROUTINE prs$block : NOVALUE =

!++
! Functional description:
!	This routine formats 'BEGIN' or '(' blocks.
!
! Formal parameters:
!	None
!
! Implicit inputs:
!	None
!
! Implicit outputs:
!	None
!
! Routine value:
!	None
!
! Side effects:
!	None
!--

    BEGIN

    LOCAL
	which;					! The open bracket for the block

    WHILE .tok EQL s_name DO
	BEGIN

	!+
	! Process a label
	!-

	! The following test is heuristic: if the expected colon is
	! one space beyond the current name, we can pre-recognize it
	! and left-adjust the label. Otherwise the label will be
	! indented with the surrounding text.

	IF CH$RCHAR (CH$PLUS (.token [tok_cp], .token [tok_len])) EQL %C' ' AND 	!
	    CH$RCHAR (CH$PLUS (.token [tok_cp], .token [tok_len] + 1)) EQL %C':'	!
	    AND NOT .nolabl
	THEN
	    out$ntbreak ()
	ELSE
	    out$break ();

	out$tok ();				! Label
	lex;

	IF .tok EQL s_colon
	THEN 					! Now we surely have a label.
	    BEGIN
	    out$tok ();				! ":"
	    out$force ();
	    lex;
	    END
	ELSE
	    utl$error (er_colon);

	END;					! Process a label

    !+
    ! Now the unlabelled block
    !-

    which = .tok;

    IF .tok EQL s_begin
    THEN
	out$force ()
    ELSE

	IF .symprop [.tok, sym_type] NEQ open_bracket
	THEN
	    (utl$error (er_block_start); out$default ();
	    lex; RETURN );

    out$tok ();					! "(" or "BEGIN"

    IF .tok EQL s_begin THEN out$force ();	! Force newline after the BEGIN

    lex;
    prs$body (.which);
    END;					! End of routine 'prs$block'

GLOBAL ROUTINE prs$body (block_context) : NOVALUE = 	!

!++
! Functional description:
!	This routine formats the block body
!
! Formal parameters:
!	block_context - open bracket, either BEGIN or '('
!
! Implicit inputs:
!	None
!
! Implicit outputs:
!	None
!
! Routine value:
!	None
!
! Side effects:
!	None
!--

    BEGIN

    LOCAL
	expr_type;

    out$push_marks ();				! Push down mark stack
    expr_type = null_symbol;

    WHILE .tok NEQ s_end_of_file DO
	BEGIN

	SELECTONE .tok OF
	    SET

	    [s_end, s_rparen, s_rbracket, s_rangle, s_end_of_file, s_percent] :
		EXITLOOP;

	    [first_decl TO last_decl] :
		prs$decl (.block_context);

	    [OTHERWISE] : 			! It should be an expression
		BEGIN
		out$indent (-1);		! Prs$expression will re-indent
		expr_type = .tok;
		prs$expression (.block_context);
		out$indent (1);

		!+
		!	Next token is an expr-terminator
		!-

		SELECTONE .tok OF
		    SET

		    [s_end, s_rparen, s_rbracket, s_rangle, s_end_of_file, s_percent] :
			EXITLOOP;

		    [s_semicolon] :
			BEGIN
			out$erase ();
			out$tok ();		! ";"
			lex;

			IF .block_context EQL s_lparen
			THEN
			    BEGIN
			    out$space (1);
			    out$pop_marks ();
			    out$push_marks ();
			    out$mark (0);
			    END
			ELSE
			    out$force ();

			END;

		    [s_comma] :
			BEGIN
			! This treatment of commas is not correct
			! according to BLISS syntax, but is needed
			! To handle references to unexpanded keyword macros.

			IF .block_context EQL s_begin THEN utl$error (er_end_block);

			out$tok ();
			out$space (1);
			lex;
			END;

		    [s_forward, s_external]:		! TT   15-Sep-81
			0;

		    [OTHERWISE] :
			BEGIN
			out$default ();		! Something unexpected, but put it out.
			lex;
			END;
		    TES;

		expr_type = null_symbol;
		END
	    TES;

	END;

    out$pop_marks ();

    IF .tok EQL s_end_of_file AND .block_context EQL s_end_of_file OR 	!
	.tok EQL s_percent AND .block_context EQL s_percent
    THEN 					! Called from prs$main, so...
	(0)					! Ready to exit
    ELSE
	BEGIN

	IF .tok EQL s_end AND .block_context EQL s_begin
	THEN
	    BEGIN
	    out$break ();
	    out$tok ();				! "END"
	    lex;

	    IF .tok NEQ s_semicolon THEN out$force ();

	    END
	ELSE
	    BEGIN

	    IF .tok EQL s_rparen AND .block_context EQL s_lparen OR 	!
		.tok EQL s_rbracket AND .block_context EQL s_lbracket OR 	!
		.tok EQL s_rangle AND .block_context EQL s_langle	!
	    THEN
		out$tok ()
	    ELSE
		(utl$error (er_end_block); out$default (); );

	    lex;
	    END;

	END;

    END;					! End of routune 'prs$body'

GLOBAL ROUTINE prs$main : NOVALUE = 		!

!++
! Functional description:
!	Main entry to parser.
!	A BLISS file may consist of one or more modules,
!	or a sequence of declarations, or it may contain
!	references to predefined macros or conditional
!	compilation directives (%IF...). The most useful
!	point at which to begin the parse is to assume that
!	the file consists of a block body, which may contain
!	any of these.
!
! Formal parameters:
!	None
!
! Implicit inputs:
!	None
!
! Implicit outputs:
!	None
!
! Routine value:
!	None
!
! Side effects:
!	None
!--

    BEGIN
    tok = s_eludom;				! Assure second files handled OK.
    prs$set_level ();				! Set macro level to 0
    lex;					! Look at first thing in the file.

    UNTIL .tok EQL s_end_of_file DO
	prs$body (s_end_of_file);

    out$break ();				! Flush any partial line
    END;					! End of routine 'prs$main'

GLOBAL ROUTINE prs$module : NOVALUE = 		!

!++
! Functional description:
!	Parses Module declarations.
!
! Formal parameters:
!	None
!
! Implicit inputs:
!	None
!
! Implicit outputs:
!	None
!
! Routine value:
!	None
!
! Side effects:
!	None
!--

    BEGIN
    out$eject (s_module);			! Provide for future ejects

    IF .tok NEQ s_name				! A name is of course expected here
    THEN
	utl$error (er_name);

    out$tok ();					! Output the module name
    ! Save the module name for the listing file headings
    lst$module (.token [tok_len], .token [tok_cp]);
    out$terminal ();				! Display the name of the module
    lex;

    !+
    ! Either switch list or nothing
    !-

    IF .tok EQL s_lparen
    THEN
	BEGIN
	out$space (1);
	out$tok ();				! " ("
	out$indent (4);
	lex;
	prs$switches ();			! Switches, ...

	IF .tok EQL s_rparen
	THEN
	    (out$break (); out$tok (); lex; )	! ")"
	ELSE
	    utl$error (er_rparen);

	out$indent (-4);
	END;

    IF .tok EQL s_equal
    THEN
	BEGIN
	out$stoks ();				! " = "
	out$force ();
	lex;
	END
    ELSE
	utl$error (er_pmodule);

    prs$block ();				! Parse a block

    UNTIL .tok EQL s_eludom DO
	BEGIN

	!+
	! An extra block END has occurred.
	! Note that ELUDOM was expected, but indent one level
	! and assume a block body follows.
	!-

	utl$error (er_pmodule);
	out$default ();
	out$indent (1);
	lex;
	prs$body (s_begin);
	END;

    END;					! End of routine 'prs$module'

GLOBAL ROUTINE prs$plit_body (block_context) : NOVALUE = 	!

!++
! Functional description:
!	This routine formats the body of a PLIT.
!	It is called recursively on a nested PLIT.
!
! Formal parameters:
!	None
!
! Implicit inputs:
!	None
!
! Implicit outputs:
!	None
!
! Routine value:
!	None
!
! Side effects:
!	None
!--

    BEGIN

    !+
    ! Check for allocation unit
    !-

    IF .symprop [.tok, sym_type] EQL alloc_unit
    THEN
	BEGIN
	out$tok ();				! "BYTE", "WORD", or "LONG"
	lex;
	END;

    IF .tok EQL s_psect				! TT  28-Sep-81
    THEN
	prs$decl (.block_context);

    prs$block ();
    END;					! End of routine 'prs$plit_body'

GLOBAL ROUTINE prs$switches (context) : NOVALUE =

!++
! Functional description:
!	This routine formats either a switches declaration,
!	Or the module head switches.
!
! Formal parameters:
!	None
!
! Implicit inputs:
!	None
!
! Implicit outputs:
!	None
!
! Routine value:
!	None
!
! Side effects:
!	None
!--

!<BLF/page>
    BEGIN

    LOCAL
	plev;					! Parenthesis level

    plev = 0;

    WHILE .tok NEQ s_end_of_file DO
	BEGIN

	SELECTONE .tok OF
	    SET

	    [s_rparen] :
		BEGIN
		plev = .plev - 1;

		IF .plev LSS 0			! End of switch list in module header
		THEN
		    EXITLOOP 			! Caller will handle this token
		ELSE
		    out$tok ();			! ") "

		out$space (1);
		END;

	    [s_lparen] :
		BEGIN
		plev = .plev + 1;
		out$space (1);
		out$tok ();			! "("
		END;

	    [s_comma] :
		BEGIN
		out$tok ();			! ","

		IF .plev EQL 0 THEN out$force () ELSE out$space (1);

		END;

	    [s_semicolon] :
		BEGIN

		IF .plev EQL 0
		THEN
		    EXITLOOP 			! Caller will handle this token
		ELSE
		    (out$tok (); out$force (); );	! " ; "

		END;

	    [first_decl TO last_decl] :
		out$tok ();

	    [OTHERWISE] :
		out$default ();			! Anything, usually identifiers
	    TES;

	lex;
	END;

    END;					! End of routine 'prs$switches'

%TITLE 'Last page of PARSE1.BLI'
END						! End of module 'PARSE1'

ELUDOM