Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

!<BLF/lowercase_user>
!<BLF/uppercase_key>
!<BLF/synonym iob = x>
!<BLF/synonym data = x>
!<BLF/synonym characters = x>
MODULE output (					!

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

		IDENT = '8.1 '
		) =
BEGIN

!++
! Facility: BLISS formatter
!--

! Abstract:
!
!	This is the output module for the BLISS formatter.  It
!	accepts input from either the parser, or the LEX module.
!	It is responsible for controlling the output file
!	and the output buffer, and is the only module
!	having access to it.
!
! Environment: transportable, using XPORT
!
!
! REVISION HISTORY
!
!	16-Nov-81	TT	Removed logical names for require files.
!				Tried it without RECOMP stuff in OUT$TRIM,
!				but then on IF..THEN..BEGIN  sets, you lose
!				all tabs for the BEGIN.
!
!	15-Feb-82	TT	Don't print anything to terminal unless
!				/LOG was specified by the user.
!
! END OF REVISION HISTORY
!--

!<blf/page>

!
! Table of contents:
!--

FORWARD ROUTINE
    break_stack : NOVALUE,
    break1 : NOVALUE,
    break2 : NOVALUE,
    out$break : NOVALUE,			! Output the current line
    out$comment : NOVALUE,			! Put comment or remark
    out$cut,					! true if IF has been split up
    out$default : NOVALUE,			! Use default format
    out$erase : NOVALUE,			! Remove trailing spaces
    out$eject : NOVALUE,			! Place pagemark in file
    out$file : NOVALUE,				! Set switch to produce file
    out$force : NOVALUE,			! Force new line on next write
    out$gag : NOVALUE,				! Inhibit output of tokens
    out$indent : NOVALUE,			! Reset relative indentation level
    out$mark : NOVALUE,				! Mark break points for IF-THEN-ELSE
    out$nit : NOVALUE,				! Initialization
    nomarks : NOVALUE,				! Clear marks
    out$ntbreak : NOVALUE,			! Calls break1
    out$on,					! Test if producing file
    out$pend_skip : NOVALUE,			! Forces lines to be skipped after
    						! Current one
    out$pop_marks : NOVALUE,			! Pop mark stack
    out$print : NOVALUE,			! Debug printer
    out$push_marks : NOVALUE,			! Push down mark stack
    out$remark : NOVALUE,			! Format a short comment
    out$set_tab : NOVALUE,			! Set the tab flag
    out$skip : NOVALUE,				! Skip lines
    out$space : NOVALUE,			! Output n spaces
    out$stoks : NOVALUE,			! Space, outtok, space
    out$tab : NOVALUE,				! Simulate tab (to indent level if empty)
    out$terminal : NOVALUE,			! Prints line on terminal
    out$tok : NOVALUE,				! Output the current symbol
    out$trim : NOVALUE,				! Trim whitespace off the output line
    write_line : NOVALUE;			! Actual writing of output lines

!
! Include files:
!--

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

REQUIRE 'BLFIOB';				! Defines in_iob etc.

REQUIRE 'BLFMAC';				! Defines macros 'lex', 'msg', etc.

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

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

!
! Macros:
!--

MACRO
    remark_col =
	ctl$switch (sw_rem_tabs)*tab_size + 1%;

!
! Equated symbols:
!--

LITERAL
    bliss_name = 31,				! Length of a BLISS identifier
    true = 1 EQL 1,
    false = 1 NEQ 1,
    half_word = %BPVAL/2,
    half_mask = 1^half_word - 1,
    tab_char = %O'11',				! Tab
    tab_size = 8,				! Physical tab space
    logical_tab = 4,				! Size of one of them
    form_feed = %O'14',				! Page mark
    buff_size = 140;				! Size of output buffer

!
! Own storage:
!--

OWN
    blank_lines,				! Number of blank lines immediately
    						!  preceding the current line
    buffer : VECTOR [CH$ALLOCATION (buff_size)],
    column,					! Column of next_pos
    ! The following variable exists only because of an anomaly in EZIO:
    ! the first character written to a newly opened file is lost; thus
    ! one extra line must be written to the first in a series of input
    ! files, but not to the remainder. When the anomaly is resolved, all
    ! references to ezio_bug can be removed.
    ezio_bug : INITIAL (true),
    force_nl,					! True after ; or remark
    gag_flag,					! True inhibits output of tokens.
    indent,					! Number of columns skipped to
    						!  Get to current level
    line_blank,					! True if line is visually empty
    lines_per_page,				! To help with page breaks
    next_pos,					! Next free position in buffer
    out_req,					! flag = length of filespec
    last_eject,					! argument of last eject call
    skips_pending,				! The number of lines to be skipped
    						! After the current line is written
    tab_flag;					! To tab or not to tab...

OWN 						! Storage for marking IF-THEN-ELSE etc.
    last_pos : INITIAL (CH$PTR (buffer)),
    mark_stack : VECTOR [300],
    m_ptr : INITIAL (0),
    nmarks : INITIAL (0);

!
! External references:
!--

EXTERNAL
    in_pc_if;					! Level of %IF control

EXTERNAL ROUTINE
    ctl$switch,					! Control switch function
    lst$line : NOVALUE,				! LSTING
    lst$on,					! LSTING
    scn$verbatim,				! Scanner state function
    utl$error;					! Central error reporting

EXTERNAL
    token : tok_block;				! One symbol at a time

ROUTINE break_stack : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine puts a break mark in the current mark-stack frame
!	and all its predecessors. Thus at whatever level a line break
!	occurs, the current control structure is known to the parsers
!	to be broken up.
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN

    LOCAL
	ptr;					!

    ptr = .m_ptr;

    UNTIL .ptr EQL 0 DO
	BEGIN
	mark_stack [.ptr] = .mark_stack [.ptr] OR 1^half_word;
	ptr = .mark_stack [.ptr - 1];
	END;

    END;					! End of routine 'break_stack'

ROUTINE break1 : NOVALUE = 			!

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine terminates writing to the current line,
!	writes it out, and resets appropriate state variables.
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	The current line is written, and the buffer is cleared and
!	pointers and counters reset.
!
!--

    BEGIN

    LOCAL
	len;

    out$trim ();				! trim spaces from end of line
    len = CH$DIFF (.next_pos, CH$PTR (buffer));

    IF .len LSS 0 THEN (next_pos = CH$PTR (buffer); len = 0; );

    IF NOT scn$verbatim () THEN write_line ();

    last_pos = next_pos = CH$PTR (buffer);
    column = 1;
    CH$FILL (%C' ', buff_size, .next_pos);	! Clear buffer
    force_nl = false;				! Reset

    IF .m_ptr NEQ 0 THEN break_stack ();

    blank_lines = (IF .line_blank THEN .blank_lines + 1 ELSE 0);
    line_blank = true;

    IF .skips_pending GTR .blank_lines
    THEN
	BEGIN

	IF NOT scn$verbatim () THEN write_line ();	! Skip at most one line

	blank_lines = .skips_pending;
	END;

    skips_pending = 0;
    END;					! End of routine 'break1'

ROUTINE break2 : NOVALUE = 			!

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine breaks up an IF-THEN-ELSE expression,
!	writing all except the last segment.
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	The current line is written, and the buffer is cleared and
!	pointers and counters reset.
!
!--

!<BLF/page>

    BEGIN

    LOCAL
	col_zero,
	len,
	len_segment,
	nmarks,
	ptr,
	temp_line : VECTOR [CH$ALLOCATION (buff_size)];

    IF NOT scn$verbatim ()
    THEN
	BEGIN

	!+
	! Break up the line if there are marks from the parsers.
	!-

	IF .m_ptr GTR 0
	THEN
	    BEGIN

!	    IF CH$DIFF (.next_pos, .last_pos) NEQ 0 OR 	!
!		.nmarks EQL 0
!	    THEN
		out$mark (0);			! Mark the end of the line

	    out$push_marks ();			! Complete the current stack frame
	    out$pop_marks ();
	    CH$MOVE (CH$DIFF (.next_pos, CH$PTR (buffer)), 	!
		CH$PTR (buffer), 		!
		col_zero = CH$PTR (temp_line));	! Copy whole line, then split it
	    next_pos = CH$PTR (buffer);
	    ptr = 0;

	    UNTIL .ptr GTR .m_ptr DO
		BEGIN
		nmarks = .mark_stack [.ptr] AND half_mask;

		INCR i FROM 1 TO .nmarks DO
		    BEGIN

		    IF (len_segment = (.mark_stack [.ptr + .i]) AND half_mask) NEQ half_mask
		    THEN
			BEGIN
			indent = (.mark_stack [.ptr + .i])^(-half_word);
			mark_stack [.ptr + .i] = half_mask;	! Erase the used mark

			IF .len_segment NEQ 0
			THEN
			    BEGIN

			    LOCAL
				cp,
				ch;

			    next_pos = CH$MOVE (.len_segment, .col_zero, .next_pos);
			    line_blank = false;
			    col_zero = CH$PLUS (.col_zero, .len_segment);
			    cp = CH$PTR (buffer);
			    column = 1;

			    IF CH$RCHAR (.cp) EQL form_feed THEN cp = CH$PLUS (.cp, 1);

			    WHILE ch = CH$RCHAR_A (cp) EQL tab_char DO
				column = (((.column - 1)/tab_size) + 1)*tab_size + 1;

			    column = .column + CH$DIFF (.next_pos, .cp) + 1;
			    END;

			IF (.i EQL .nmarks) AND (.ptr EQL .m_ptr) THEN EXITLOOP;

			IF .len_segment NEQ 0 THEN write_line ();

			!+
			! Make whitespace before segments 2 thru nmarks
			!-

			next_pos = CH$PTR (buffer);
			column = 1;
			out$tab ();
			blank_lines = (IF .line_blank THEN .blank_lines + 1 ELSE 0);
			line_blank = true;
			END;

		    END;

		mark_stack [.ptr + .nmarks + 1] = CH$PTR (buffer);
		ptr = .ptr + .nmarks + 3;
		break_stack ();			! Mark stack as broken
		END;

	    END;

	END;

    nomarks ();					! Erase all marks in this stack frame
    END;					! End of routine 'break2'

GLOBAL ROUTINE out$break : NOVALUE = 		!

!++
! FUNCTIONAL DESCRIPTION:
!
!	This is an interface routine to break1.
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN

    IF .line_blank
    THEN
	BEGIN
	column = 1;
	last_pos = next_pos = CH$PTR (buffer);
	force_nl = false;
	END
    ELSE
	BEGIN
	break2 ();				! Handle multi-format lines (e.g. IF-then-else)
	out$trim ();				! Break2 may have left a tab in the buffer

	IF NOT .line_blank THEN break1 ();

	END;

    out$set_tab (true);
    END;					! End of routine 'out$break'

GLOBAL ROUTINE out$comment : NOVALUE = 		!

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine is used to output a comment. In some contexts
!	there may already be something on the line, in which case
!	the comment is treated as a remark.
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN

    IF .nmarks EQL 1 THEN nomarks ();		! Don't break in comma list

    IF .nmarks GTR 0 AND 			! Erase mark immediately preceding remark
	CH$DIFF (.next_pos, .last_pos) EQL 0
    THEN
	BEGIN					! Erase the last mark
	last_pos = CH$PLUS (.last_pos, -(.mark_stack [.m_ptr + .nmarks] AND half_mask));
	mark_stack [.m_ptr + .nmarks] = 0;
	nmarks = .nmarks - 1;
	END;

    IF NOT .line_blank THEN out$break ();

    out$tok ();
    END;					! End of routine 'out$comment'

GLOBAL ROUTINE out$cut =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine returns the value true or false depending on
!	whether the current IF statement has been broken up or is
!	on one line, respectively.
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN
    RETURN (.mark_stack [.m_ptr]^(-half_word));
    END;					! End of routine 'out$cut'

GLOBAL ROUTINE out$default : NOVALUE = 		!

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine provides a default formatting action
!	for each token type. This action is especially useful
!	in situations in which the token is incorrect in its context
!	(e.g. where the coder has used a reserved word incorrectly,
!	or a syntax anomally has confused the parsers,) but can also
!	be used in the general case if nothing special is required.
!	Its use in the latter case is to be discouraged since the
!	table look-up is relatively slow.
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	token
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

!<BLF/page>

    BEGIN

    SELECTONE .token [tok_type] OF
	SET

	[s_end_of_file] :
	    RETURN;

	[s_lparen, s_lbracket] :
	    (out$space (1); out$tok (); );

	[s_rparen, s_rbracket] :
	    (out$erase (); out$tok (); );

	[s_plus, s_minus] :
	    out$stoks ();

	[s_comma] :
	    (out$erase (); out$tok (); out$space (1); );

	[s_colon] :
	    out$stoks ();

	[s_semicolon] :
	    (out$erase (); out$tok (); out$force (); );

	[s_equal] :
	    out$stoks ();

	[s_percent] :
	    (utl$error (er_macro_body); out$stoks (); );

	[s_begin, s_end] :
	    (out$break (); out$tok (); out$force (); );

	[s_from, s_to, s_by] :
	    out$stoks ();

	[s_set] :
	    (out$break (); out$tok (); out$force (); );

	[s_tes] :
	    (out$break (); out$tok (); out$force (); );

	[s_of] :
	    out$stoks ();

	[s_eqv, s_xor, s_or, s_and, s_not] :
	    out$stoks ();

	[s_eql TO s_geqa] :
	    out$stoks ();

	[s_routine] :
	    (out$eject (s_routine); out$ntbreak (); out$stoks (); );

	[s_module] :
	    (out$nit (); out$stoks (); out$eject (s_module); );

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

	[s_eludom] :
	    BEGIN
	    out$ntbreak ();
	    out$tok ();
	    out$break ();			! Ensure gets out
	    out$eject (s_eludom);
	    out$nit ();
	    END;

	[first_control TO last_control] :
	    (out$break (); out$stoks (); );

	[s_then, s_else] :
	    BEGIN
	    out$break ();
	    out$indent (-1);
	    out$tok ();
	    out$indent (+1);
	    utl$error (er_then_else);
	    END;

	[s_rep, s_with] :
	    out$stoks ();

	[OTHERWISE] :
	    out$tok ();
	TES;

    END;					! End of routine 'out$default'

GLOBAL ROUTINE out$eject (arg) : NOVALUE = 	!

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine inserts a form_feed character at the front
!	of the current output line. At the time of insertion,
!	there may already be some text on the line, for example
!	"GLOBAL ROUTINE name". If that line were preceded by
!	%TITLE or %SBTTL, however, the form-feed is assumed
!	to be unnecessary and is not inserted.
!
! Formal parameters:
!
!	arg = token being processed; one of
!		s_eludom
!		s_module
!		s_p_title
!		s_p_subtitle
!		s_routine
!		0	(If called due to !<BLF/PAGE>)
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	last_eject is set when an eject is issued for a routine
!	so that subsequent %TITLE, etc. will cause ejects.
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

!<BLF/page>

    BEGIN

    LOCAL
	len,
	form_buf : VECTOR [CH$ALLOCATION (buff_size)];	! Copy of current line

    IF (SELECTONE .arg OF
	    SET
	    [0, s_eludom] : true;
	    [s_module] : .last_eject EQL s_module OR 	!
		.last_eject EQL s_routine;
	    [s_p_title] : .last_eject NEQ s_eludom;
	    [s_p_subtitle] : .last_eject NEQ s_eludom AND 	!
		.last_eject NEQ s_p_title;
	    [s_p_subtitle] : .last_eject NEQ s_eludom AND 	!
		.last_eject NEQ s_p_title;
	    [s_routine] : (.last_eject EQL 0 OR 	!
		.last_eject EQL s_routine OR 	!
		.last_eject EQL s_module) AND 	!
		.in_pc_if EQL 0;
	    TES)
    THEN
	BEGIN					! Issue formfeed char.

%IF %BLISS (BLISS16) OR %BLISS (BLISS32)
%THEN
	! Produce formfeed as a separate record

	IF out$on ()
	THEN
	    $xpo_put (				!
		string = (1, CH$PTR (UPLIT (form_feed))), 	!
		iob = out_iob);

	IF lst$on () THEN lst$line (1, CH$PTR (UPLIT (form_feed)));	! Let lst$line count lines + pages

%ELSE
	! Insert formfeed as first character of the present line
	CH$MOVE (len = CH$DIFF (.next_pos, CH$PTR (buffer)), CH$PTR (buffer), CH$PTR (form_buf));
	CH$WCHAR (form_feed, CH$PTR (buffer));
	next_pos = CH$MOVE (.len, CH$PTR (form_buf), CH$PTR (buffer, 1));
	line_blank = false;
%FI

	END;

    last_eject = .arg;
    END;					! END of routine 'out$eject'

GLOBAL ROUTINE out$erase : NOVALUE = 		!

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine examines the output buffer and, if the final
!	character is a space, erases it.
!	The routine is called when a token with high binding
!	strength ("," or ";", etc.) is output to the buffer.
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	"column" and "next_pos" may be recomputed.
!
!--

    BEGIN

    LOCAL
	chr;

    chr = CH$RCHAR (CH$PLUS (.next_pos, -1));

    IF .column GTR 1 AND (.chr EQL %C' ')
    THEN
	BEGIN
	column = .column - 1;
	next_pos = CH$PLUS (.next_pos, -1);
	END;

    IF .column EQL 1				! If the line was all whitespace
    THEN 					! call it empty.
	line_blank = true;

    END;					! End of routine 'out$erase'

GLOBAL ROUTINE out$file (arg) : NOVALUE = 	!

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine sets the flag which controls production of the
!	primary output file. This flag is tested by routine "Out$on".
!
! Formal parameters:
!
!	arg	= length of the file specification for the output file.
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN
    out_req = .arg NEQ 0;
    END;					! End of routine 'out$file'

GLOBAL ROUTINE out$force : NOVALUE = 		!

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine is called when the caller wants to make
!	sure that no more syntactic symbols will be placed on the
!	current line.  Normally a semicolon terminates a line
!	unless a remark follows, which is why the line cannot
!	be broken by the parser immediately on seeing the ';'.
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	Force_nl
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN
    force_nl = true;
    END;					! End of routine 'out$force'

GLOBAL ROUTINE out$gag (arg) : NOVALUE = 	!

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine sets the switch "gag_flag" to the argument
!	value. If gag_flag is set "true", output of tokens is
!	inhibited.
!
! Formal parameters:
!
!	Arg = true or false.
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN
    gag_flag = .arg;
    END;					! End of routine 'out$gag'

GLOBAL ROUTINE out$indent (levels) : NOVALUE = 	!

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine sets the indentation level relative to
!	the previous indentation level.
!
! Formal parameters:
!
!	Levels - the number of levels to change. Levels may be
!	positive or negative.
!
! Implicit inputs:
!
!	Indent - current indentation level
!	Logical_tab - number of spaces in a logical tab
!
! Implicit outputs:
!
!	Indent
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN
    indent = .indent + logical_tab*.levels;
    END;					! End of routine 'out$indent'

GLOBAL ROUTINE out$mark (ind) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine builds the mark stack frame which is used in
!	the alternative formatting of control expressions, esp.
!	IF-THEN-ELSE.
!	The format of the stack frame is as follows:
!
!	----------------------
!	!  broken  ! no.marks!
!	----------------------
!	!  indent  !   mark  !
!	----------------------
!	!  indent  !   mark  !
!	----------------------
!	!      ...           !
!	----------------------
!	! character pointer  !
!	----------------------
!	!  Back pointer      !
!	----------------------
!
!	It is possible for indent to be negative.
!	If the mark has already been used but its position is required,
!	it is set to all 1's in break2.
! Formal parameters:
!
!	Ind = the change in current indentaton level associated with
!		this mark.
!
! Implicit inputs:
!
!	Indent = the current indentation level. This must be recalled
!		later if the line is split at the marks.
!	Next_pos = the current character pointer to the output line.
!
! Implicit outputs:
!
!	The current mark stack frame is extended by one entry.
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

!<BLF/page>

    BEGIN
    nmarks = .nmarks + 1;
    mark_stack [.m_ptr + .nmarks] = 		!
    (CH$DIFF (.next_pos, .last_pos)) OR 	!
    ((.indent + .ind*logical_tab)^half_word);
    last_pos = .next_pos;
    END;					! End of routine 'out$mark'

GLOBAL ROUTINE out$nit : NOVALUE = 		!

!++
! FUNCTIONAL DESCRIPTION:
!	This routine Initializes the module. It sets the
!	parameters relevant to formatting the output
!	file, and opens the file.
!
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	Sets parameters used by other routines in this module,
!	and opens output file.
!
!--

    BEGIN
    last_pos = next_pos = CH$PTR (buffer);
    column = 1;
    CH$FILL (%C' ', buff_size, .next_pos);	! Fill buffer with blanks
    last_eject = s_eludom;			! No recent ejects.
    indent = 0;
    m_ptr = 0;
    lines_per_page = 55;
    blank_lines = 0;				! No blank lines so far
    skips_pending = 0;
    out$gag (false);

    IF .ezio_bug
    THEN
	out$break ()				! One blank line to initialize i/o
    ELSE
	out$skip (1);

    ezio_bug = false;
    END;					! End of routine 'out$nit'

ROUTINE nomarks : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	The function of this routine is to clear any marks
!	which may have been set up for the present output line
!	so that the line will not be broken up. This is mainly
!	for the formatting of IF-THEN-ELSE expressions.
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN

    UNTIL .nmarks EQL 0 DO
	BEGIN
	mark_stack [.m_ptr + .nmarks] = 0;
	nmarks = .nmarks - 1;
	END;

    ! Get base of marks from previous stack frame.
    IF .m_ptr GTR 0 				! Stack is in use
    THEN 
	last_pos = .mark_stack [.m_ptr - 2] 
    ELSE 
	last_pos = CH$PTR (buffer);
    END;					! End of routine 'nomark'

GLOBAL ROUTINE out$ntbreak : NOVALUE = 		!

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine positions the line at the beginning
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN

    IF .line_blank
    THEN
	BEGIN
	column = 1;
	last_pos = next_pos = CH$PTR (buffer);
	force_nl = false;
	END
    ELSE
	BEGIN
	break2 ();
	out$trim ();

	IF NOT .line_blank THEN break1 ();

	END;

    out$set_tab (false);			! set to not tab
    END;					! End of routine 'out$ntbreak'

GLOBAL ROUTINE out$on = 			!

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine returns true if we are producing an output file.
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	true if output filespec was given,
!	false if output filespec was empty.
!
! Side effects:
!
!	None
!
!--

    BEGIN
    RETURN .out_req;
    END;					! End of routine 'out$on'

GLOBAL ROUTINE out$pend_skip (n) : NOVALUE = 	!

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine is called to insure that 'n' skips are
!	performed after the current line is output.
!
! Formal parameters:
!
!	N- the number of lines to be skipped.
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	Skips_pending- the number of skips to be performed
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN

    IF .n GTR .skips_pending THEN skips_pending = .n;

    END;					! End of routine 'out$pend_skip'

GLOBAL ROUTINE out$pop_marks : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine pops the mark stack to the previous mark-stack
!	frame.
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN
    nomarks ();					! Erase marks in current stack frame
    mark_stack [.m_ptr] = 0;			! Erase mark count and broken flag

    IF .m_ptr GTR 0
    THEN
	BEGIN
	m_ptr = .mark_stack [.m_ptr - 1];	! Go back to previous frame
	nmarks = .mark_stack [.m_ptr] AND half_mask;
	mark_stack [.m_ptr + .nmarks + 2] = 0;	! Erase back_pointer
	last_pos = .mark_stack [.m_ptr + .nmarks + 1];	! Get saved text pointer
	END;

    END;					! End of routine 'out$pop_marks'

GLOBAL ROUTINE out$print : NOVALUE = 		!

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine provides for debugging display of the current toke
!	on the terminal.
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN

    LOCAL
	string : VECTOR [CH$ALLOCATION (bliss_name + 2)],	! room for a name + crlf
	sptr;					! string pointer

    CH$FILL (' ', bliss_name + 2, CH$PTR (string));
    sptr = CH$MOVE (MIN (bliss_name, .token [tok_len]), 	!
	.token [tok_cp], 			!
	CH$PTR (string));
    CH$MOVE (2, CH$PTR (UPLIT (crlf)), .sptr);
    $xpo_put (					!
	string = (bliss_name + 2, CH$PTR (string)), 	!
	iob = tty_iob);
    END;					! End of routine 'out$print'

GLOBAL ROUTINE out$push_marks : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine pushes down the mark stack for IF-THEN-ELSE
!	expressions. It is called by DO_IF whenever a new 'IF' is seen.
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN
    mark_stack [.m_ptr + .nmarks + 1] = .last_pos;	! Save start point of next mark
    mark_stack [.m_ptr + .nmarks + 2] = .m_ptr;	! Set back-pointer
    mark_stack [.m_ptr] = .mark_stack [.m_ptr] AND (half_mask^half_word)	!
    OR .nmarks;					! Set frame length
    mark_stack [m_ptr = .m_ptr + .nmarks + 3] = 0;	! Pointer to new frame
    nmarks = 0;					! Which is empty.
    END;					! End of routine 'out$push_marks'

GLOBAL ROUTINE out$remark : NOVALUE = 		!

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine is called to place a remark in the buffer.
!	If there is room for the remark, which must be preceded
!	by a tab, the remark is simply placed in the buffer.
!	Otherwise, the current line is terminated
!	and the remark placed on the next line.
!	Remarks are assumed to contain only printing characters
!	and spaces.  Currently, this routine doesn't break
!	remarks, but if one is too long for the line it is
!	written on a line by itself.
!
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	column - Current print position in the line.
!	next_pos - Character pointer to the columnth character
!		in the buffer.
!	token - Which contains the remark
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	The remark is placed in the buffer.
!	A line may be written to the file.
!
!--

    BEGIN

    LOCAL
	num_tabs;				! Number of tabs to insert in buffer

!<BLF/PAGE>

    IF .nmarks EQL 1 THEN nomarks ();		! Don't break in comma list

    IF .nmarks GTR 0 AND 			! Erase mark immediately preceding remark
	CH$DIFF (.next_pos, .last_pos) EQL 0
    THEN
	BEGIN					! Erase the last mark
	last_pos = CH$PLUS (.last_pos, -(.mark_stack [.m_ptr + .nmarks] AND half_mask));
	mark_stack [.m_ptr + .nmarks] = 0;
	nmarks = .nmarks - 1;
	END;

    break2 ();					! Try for breakable IF expression
    out$tab ();

    IF .column + .token [tok_len] - 1 GTR ctl$switch (sw_page_width)
    THEN
	BEGIN
	out$break ();				! Remark won't fit, put on next line
	END;

    num_tabs = (remark_col - .column + tab_size - 1)/tab_size;
    column = remark_col;

    WHILE .column + .token [tok_len] GEQ ctl$switch (sw_page_width) DO
	(num_tabs = .num_tabs - 1; column = .column - 8);

    INCR i FROM 1 TO .num_tabs DO
	CH$WCHAR_A (tab_char, next_pos);

    !+
    ! Move the remark into the output buffer
    !-

    next_pos = CH$MOVE (.token [tok_len], .token [tok_cp], .next_pos);
    column = .column + .token [tok_len];
    line_blank = false;
    break1 ();
    END;					! End of routine 'out$remark'

GLOBAL ROUTINE out$set_tab (arg) : NOVALUE = 	!

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine sets the tab flag, which determines whether
!	following lines will be left-adjusted or indented.
!
! Formal parameters:
!
!	arg = True to indent, false to left-adjust
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN
    tab_flag = .arg;
    END;					! End of routine 'out$set_tab'

GLOBAL ROUTINE out$skip (lines) : NOVALUE = 	!

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine insures a certain number of blank lines
!	appear in the file.
!
! Formal parameters:
!
!	Lines - the number of blank lines to be inserted
!
! Implicit inputs:
!
!	Column
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	Blank lines are written to the output file.
!	The current line is terminated.
!
!--

    BEGIN

    IF .gag_flag THEN RETURN;

    IF NOT .line_blank				! The line's non-empty
    THEN
	BEGIN
	out$break ();
	END;

    INCR i FROM 1 TO .lines - .blank_lines DO
	BEGIN
	break1 ();
	END;

    END;					! End of routine 'out$skip'

GLOBAL ROUTINE out$space : NOVALUE = 		!

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine is called to ensure at least one space
!	appears before a token to be passed to out$tok.
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	The current line is written if the space causes the
!	cursor to move to the end of the line.
!
!--

!<BLF/PAGE>

    BEGIN

    LOCAL
	ch;					! Previous character

    IF .force_nl THEN (out$break (); RETURN );

    ch = CH$RCHAR (CH$PLUS (.next_pos, -1));	! Char preceding next_pos

    IF .column EQL 1				! Clean
	OR .ch EQL %C' '			! Or it was blank
	OR .ch EQL tab_char			! Or it was a tab
    THEN
	RETURN;					! No need to space

    IF .column GTR ctl$switch (sw_page_width)
    THEN
	BEGIN					! Break1 it
	break2 ();				! Try breaking up the line first

	IF .column GTR ctl$switch (sw_page_width)
	THEN
	    BEGIN
	    break1 ();

	    IF .tab_flag THEN out$tab ();

	    RETURN 				! No longer need space
	    END;

	END;					! Break1 it

    CH$WCHAR_A (%C' ', next_pos);
    column = .column + 1;
    END;					! END of routine 'out$space'

GLOBAL ROUTINE out$stoks : NOVALUE = 		!

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine is a contraction for putting out a token
!	surrounded by spaces.
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    IF .token [tok_len] GTR 0
    THEN
	BEGIN
	out$space (1);
	out$tok ();
	out$space (1);
	END;					! End of routine 'out$stoks'

GLOBAL ROUTINE out$tab : NOVALUE = 		!

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine simulates the tab key on a typewriter.
!	Tabs are set at eight spaces each, to correspond to TTY's.
!	If the buffer pointer 'next_pos' is pointing to
!	the beginning of the buffer, a call on this
!	routine indents to the current indentation level.
!	Otherwise, a tab is inserted.
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	State variables for this module.
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	The cursor, as defined by column, is positioned.
!	Next_pos is updated.
!
!--

    BEGIN

    LOCAL
	num_tabs,				! Number of tabs
	rem;					! Number of columns left over

!<BLF/PAGE>

    IF .column EQL 1 OR 			!
	.column EQL 2 AND CH$RCHAR (CH$PTR (buffer)) EQL form_feed	! Start of buffer
    THEN
	BEGIN					! Move cursor to current level
	indent = MAX (0, .indent);		! Correct negative indentation now.
	column = .indent + 1;
	num_tabs = MIN (9, .indent/tab_size);
	rem = .indent MOD tab_size;
	next_pos = CH$FILL (tab_char, .num_tabs, .next_pos);	! Place necessary tabs
	next_pos = CH$FILL (%C' ', .rem, .next_pos);	! Pad with spaces
	END					! Move cursor to current level
    ELSE
	BEGIN					! Insert just one tab

	IF .column LEQ ctl$switch (sw_page_width)
	THEN
	    BEGIN
	    CH$WCHAR_A (tab_char, next_pos);
	    column = (((.column - 1)/tab_size) + 1)*tab_size + 1;
	    END;

	END;					! Insert just one tab

    END;					! End of routine 'out$tab'

GLOBAL ROUTINE out$terminal : NOVALUE = 	!

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine prints the current line buffer on the terminal.
!	Although designed to announce the start of modules and routines,
!	it can be used for debugging also.
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	Current contents of output buffer.
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN
    IF ctl$switch (sw_log) or ctl$switch (sw_debug)
    THEN
	$xpo_put (					!
	    string = (CH$DIFF (.next_pos, CH$PTR (buffer)), 	!
	    CH$PTR (buffer)), 			!
	    iob = tty_iob);
    END;					! End of routine 'out$terminal'

GLOBAL ROUTINE out$tok : NOVALUE = 		!

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine puts a token in the buffer if the token fits
!	on the current line.  If not, it first breaks the line.
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	tab_flag : determines whether to issue tab sequence in col. 1
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	A line may be written if the token doesn't fit on the current
!	line.
!
!--

!<BLF/page>

    BEGIN

    IF .gag_flag THEN RETURN;

    IF .force_nl THEN out$break ();

    IF .tab_flag AND 				!
	(.column EQL 1 OR 			!
	.column EQL 2 AND CH$RCHAR (CH$PTR (buffer)) EQL form_feed)
    THEN
	out$tab ();

    IF .column + .token [tok_len] - 1 GTR ctl$switch (sw_page_width)
    THEN
    ! Token is too long
	BEGIN
	break2 ();				! Try for breakable IF

	IF .column + .token [tok_len] - 1 GTR ctl$switch (sw_page_width)
	THEN
	    BEGIN				! Still too long.

	    LOCAL
		dots;				! Count of preceding periods

	    dots = 0;

	    WHILE CH$RCHAR (CH$PLUS (.next_pos, -1)) EQL %C'.' DO

	    !+
	    ! Bind any preceding '.'s to the current token,
	    ! on the next line.
	    !-

		BEGIN
		dots = .dots + 1;
		next_pos = CH$PLUS (.next_pos, -1);
		column = .column - 1;
		END;

	    break1 ();

	    IF .tab_flag THEN out$tab ();

	    INCR i FROM 1 TO .dots DO
		BEGIN
		CH$WCHAR_A (%C'.', next_pos);
		column = .column + 1;
		END;

	    END;

	END;

    next_pos = CH$MOVE (.token [tok_len], .token [tok_cp], .next_pos);	! Put token in buffer
    column = .column + .token [tok_len];

    IF .token [tok_len] GTR 0 THEN line_blank = false;

    END;					! End of routine 'out$tok'

GLOBAL ROUTINE out$trim : NOVALUE = 		!

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine examines the output buffer and, if the final
!	sequence of characters consist of one or more spaces, trims
!	them. The routine is called when it is time to write the buffer
!	or when a token with high binding strength ("," or ";", etc.)
!	is output to the buffer.
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	"column" and "next_pos" may be recomputed.
!
!--

    BEGIN

    LOCAL
	chr,
	recomp;

    chr = CH$RCHAR (CH$PLUS (.next_pos, -1));
    recomp = false;				! assume no trailing tabs

    WHILE (.chr EQL %C' ' OR .chr EQL tab_char)	!
	AND CH$DIFF (.next_pos, CH$PTR (buffer)) GTR 0 DO
	BEGIN
	! Scan backwards over whitespace

	IF .chr EQL tab_char THEN recomp = true;

	next_pos = CH$PLUS (.next_pos, -1);
	column = .column - 1;
	chr = CH$RCHAR (CH$PLUS (.next_pos, -1));
	END;

    IF .recomp
    THEN
	BEGIN
	! A tab was found at the end, so the column count is wrong
	! Recompute column count from the left

	LOCAL
	    last_col,
	    last_pos,
	    pos;

	pos = last_pos = CH$PTR (buffer);
	column = last_col = 1;

	WHILE CH$DIFF (.pos, .next_pos) LSS 0 DO
	    BEGIN
	    chr = CH$RCHAR_A (pos);

	    CASE .chr FROM 0 TO 128 OF
		SET

		[form_feed] :
		    (last_col = .column; last_pos = .pos);

		[%C' '] :
		    column = .column + 1;

		[tab_char] :
		    column = (((.column - 1)/tab_size) + 1)*tab_size + 1;

		[INRANGE] :
		    (last_col = column = .column + 1; last_pos = .pos);
		TES;

	    END;

	column = .last_col;
	next_pos = .last_pos;
	END;

    IF .column EQL 1				! If the line was all whitespace
    THEN 					! call it empty.
	line_blank = true;

    END;					! End of routine 'out$trim'

ROUTINE write_line : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine adjusts the length of the current line,
!	then performs the XPORT calls to cause actual
!	writing of lines to the output and listing files.
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	The text resides in 'buffer', beginning at the first
!	character position. The next available character position is
!	indicated by .next_pos.
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN

    LOCAL
	len;

    out$trim ();				! trim whitespace from end of line
    len = CH$DIFF (.next_pos, CH$PTR (buffer));

    IF .len LSS 0 THEN (next_pos = CH$PTR (buffer); len = 0; );

    IF out$on ()
    THEN
	$xpo_put (				!
	    string = (.len, CH$PTR (buffer)), 	!
	    iob = out_iob);

    IF lst$on ()
    THEN
	BEGIN

	IF .len EQL 0 THEN out$tab ();

	lst$line (CH$DIFF (.next_pos, CH$PTR (buffer)), CH$PTR (buffer));
	out$trim ();
	END;

    END;					! End of routine 'write_line'

%TITLE 'Final page of OUTPUT.BLI'
END						! End of module  OUTPUT

ELUDOM