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

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

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

		IDENT = '07'
		) =
BEGIN

!++
! Facility:
!	Lexical scanner for BLISS formatter
!
! Abstract:
!
!	This module reads a source file of BLISS symbols and
!	returns each one on demand. The tokens are returned in
!	a global block called "token". The tokens recognized
!	are defined in the required file 'TOKTYP.BLI'.
!	In the process of scanning the input file, the scanner
!	may at times direct its attention to alternative input
!	streams: either to a require file of control comment lines,
!	or (in the case of the SYNONYM control line) to a point
!	internal to an input line. To do this, the scanner
!	maintains a multi-level context which can be switched as
!	required. The context, when switched, is saved in a stack
!	whose pointer is named "stk". Routines SCN$PUSH and SCN$POP
!	handle the switching.
!
! Environment:
!	BLISS Formatter ("PRETTY")
!
! Modifications:
!
! 01-04	-Numerous bug fixes and added facilities.
! 05	-Multiple contexts added, to implement SYNONYM control.
! 06	-support multiple operating systems' command lines
! 07	-Use XPORT I/O and better command lines
!--

!<Blf/page>

!
! Table of contents:
!--

FORWARD ROUTINE
    nxch,					! Next character from input stream
    readaline,					! Reads records of pure text
    scn$fin_verb : NOVALUE,			!
    scn$getsym : NOVALUE,			! Central routine to get next symbol
    scn$init,					! Initialization routine
    scn$mbstrt : NOVALUE,			! Macro bodies are left unformatted
    scn$mfin : NOVALUE,				!
    scn$plit : NOVALUE,				! alter plit count
    scn$pop : NOVALUE,
    scn$push : NOVALUE,
    scn$set_in_unit : NOVALUE,
    scn$strt_verb : NOVALUE,			! User-formatted
    scn$verbatim;				! Logical 'OR' of verbatim flags

!
! Include files:
!--

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

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

REQUIRE 'BLFIOB';				! defines in_iob, etc.

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:
!--

!
! Equated symbols:
!--

LITERAL
    true = 1 EQL 1,
    false = 1 NEQ 1,
    form_feed = 12,
    quote = %C'''',
    eof = -2,
    newline = -1,
    tab_char = 9;

!
! Own storage:
!--

OWN
    all_white,					! True until printable char found
    						! unprocessed character in 'buf'
    exp_verbatim,				! Explicit verbatim flag
    mac_verbatim,				! Implicit verbatim flag used in macro-bodies
    plit_count,					! Count of nested PLITs
    plit_verbatim,				! implicit verbatim flag used in PLIT- bodies
    state,					! State of finite state machine = scanner.
    temp : VECTOR [CH$ALLOCATION (buf_len)];	! Temporary buffer for macros

OWN 						! Variables used in control of PLIT formatting
    line_broken,				! first line of PLIT body written
    set_linebreak;				! Prepared to write first line of plit body

OWN 						! Variables pertaining to scanner input state
    alt_state : BLOCK [scn_blk_size] FIELD (in_field),
    in_state : BLOCK [scn_blk_size] FIELD (in_field),
    inp_iob_addr : INITIAL (in_iob),		! Either in_ or req_ IOB address
    STACK : VECTOR [3],				! for scanner state pointers
    stack_level : INITIAL (0),
    stk : REF BLOCK FIELD (in_field) INITIAL (in_state);

GLOBAL
    token : tok_block;

!
! External references:
!--

EXTERNAL ROUTINE				! In module...
    ctl$switch,					! CONTRL
    lst$line : NOVALUE,				! LSTING
    lst$on,
    out$break : NOVALUE,			! OUTPUT
    out$eject : NOVALUE,
    out$force : NOVALUE,
    out$gag : NOVALUE,
    out$ntbreak : NOVALUE,
    out$on,
    out$remark : NOVALUE,
    out$tok : NOVALUE,
    utl$error : NOVALUE;			! UTILIT

ROUTINE nxch = 					!

!++
! Functional description:
!
!	This routine returns each character from the input stream
!	sequentially. One 'newline' pseudo character is returned
!	between records.
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	Current scanner state block and its pointer, sp
!
! Implicit outputs:
!
!	New scanner state.
!
! Routine value:
!
!	The next character from the input stream, or 'newline'
!
! Side effects:
!
!	This routine may trigger a read from the input file
!	Cp is left pointing to the character following the one returned.
!
!--

    BEGIN

    IF .set_linebreak
    THEN
	BEGIN
	! In a PLIT body, the first line is formatted and the rest are
	! left alone until the closing ')'. The breakoff of the first
	! line is done here when the end-of-line has already been parsed.
	! First make sure we don't lose a remark at this point.
	IF .token [tok_type] EQL remark THEN out$remark ();
	scn$mbstrt (s_plit);			! Break up line & get next
	line_broken = true;
	set_linebreak = false;
	END;

    IF .stk [rem] EQL 0
    THEN 					! All characters in this record
    						! have been returned
	BEGIN					! Return a 'newline' pseudo char
	CH$RCHAR_A (stk [cp]);
	stk [rem] = -1;

	IF .line_broken				!
	THEN
	    line_broken = .plit_verbatim
	ELSE
	    set_linebreak = .plit_count GTR 0;

	RETURN stk [chr] = newline;
	END;					! Return a 'newline' pseudo char

    IF .stk [rem] LEQ -1
    THEN

	IF readaline () EQL -1			! That's all, folks
	THEN
	    RETURN eof
	ELSE
	    IF .plit_count GTR 0
	    THEN
		BEGIN
		out$ntbreak ();			! Make sure the line gets broken
		plit_verbatim = true;
		END;

    IF .stk [len] EQL 0
    THEN
	BEGIN
	CH$RCHAR_A (stk [cp]);
	stk [rem] = -1;

	IF .line_broken THEN line_broken = .plit_verbatim ELSE (set_linebreak = .plit_count GTR 0);

	RETURN stk [chr] = newline;
	END
    ELSE
	BEGIN

	IF (stk [chr] = CH$RCHAR_A (stk [cp])) EQL tab_char
	THEN
	    stk [col] = ((.stk [col] + 7)/8)*8 + 1
	ELSE stk [col] = .stk [col] + 1;

	stk [rem] = .stk [rem] - 1;
	RETURN .stk [chr];
	END;

    END;					! End of routine 'nxch'

ROUTINE readaline = 				!

!++
! Functional description:
!
!	This routine reads the next record from the input file.
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	Len - the length of the input record in characters
!	Cp - a character pointer to the first character
!	rem - the number of chars remaining in the line
!
! Routine value:
!
!	-1 On end of file, else 0
!
! Side effects:
!
!	When EOF occurs on "req_iob", input from "in_iob" is resumed.
!
!--

    BEGIN

    MAP
	inp_iob_addr : REF $xpo_iob ();

    IF scn$verbatim ()				! Nobody else is printing
    THEN

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

	    IF out$on ()
	    THEN
		! ...............................................
		$xpo_put (			! Here is where lines of text
		    string = (.stk [len], CH$PTR (stk [buf])), 	! are written
		    iob = out_iob);		! in verbatim mode.
		! ...............................................

	    IF lst$on () THEN lst$line (.stk [len], CH$PTR (stk [buf]));

	    END;

    ! ...........................................
    $xpo_get (					! Here is where lines
	iob = .inp_iob_addr);			! of text are read in.
    ! ...........................................
    stk [len] = .inp_iob_addr [iob$h_string];	! Note the line length
    CH$MOVE (.stk [len], 			! Move the line into stack buffer
	.inp_iob_addr [iob$a_string], 		!
	stk [cp] = CH$PTR (stk [buf]));

    IF .inp_iob_addr [iob$v_eof]		! check for end-of-file
    THEN
	RETURN -1;

    stk [rem] = .stk [len];
    stk [col] = 0;
    all_white = true;				! Assume line is whitespace.
    RETURN 0;
    END;					! End of routine 'readaline'

GLOBAL ROUTINE scn$fin_verb : NOVALUE = 	!

!++
! Functional description:
!
!	This routine is called when either
!	a) a !<BLF/format> is found in the input text
!	b) a !<Blf/page> is found in the input text.
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN
    exp_verbatim = false;
    END;					! End of routine 'scn$fin_verb'

GLOBAL ROUTINE scn$getsym (in_file) : NOVALUE = 	!

!++
! Functional description:
!
!	This routine is called to return the next symbol from
!	the input stream in the global block 'token'.
!	The plan is to simulate a finite state machine (FSM).
!	The outermost loop controls state transitions.
!	State 0 is the initial state and is memoryless. It is
!	called whenever a token is desired with no memory
!	of the tokens which preceeded it, for example, it is
!	not called when we know we are in the middle of a block
!	comment. The convention for reading characters is that
!	each state assumes 'stk [chr]' contains the first unprocessed character.
!	A token string may end in a newline. Since a character must
!	be read after recognition, this will overwrite the buffer
!	containing the token string just recognized. Therefore,
!	the token string is moved into an auxilliary buffer if
!	it has been recognized by hitting the newline.
!
!	State transitions:
!
!	0- 1,3,5,6,7
!	1- 2,4
!	2- 2,0
!	3- 4
!	4- 0
!	5- 0
!	6- 0
!	7- 0
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

!<Blf/page>

    BEGIN

    LABEL
	loop;

    BIND
	ctrl_z = 26;				! ASCII code for control-z

    OWN
	end_com_pending : INITIAL (false),	! True after !+, false until then or after !-
	tok_buf : VECTOR [CH$ALLOCATION (buf_len)];	! Auxilliary buffer to prevent overwrite

loop :
    BEGIN

    WHILE 1 DO
	BEGIN					! FSM dispatch

	CASE .state FROM 0 TO 7 OF
	    SET

	    [0] :
		BEGIN				! State 0

		!+
		! State 0 is the state that dispatches to all
		! other states. It decides, based on the
		! the first character it sees what kind of
		! lexeme to attempt to recognize.
		!-

		WHILE .stk [chr] LSS %C'!' OR 	!
		    .stk [chr] GTR %O'175' DO 	! All nonprintable characters
		    BEGIN

		    IF .stk [chr] EQL eof OR .stk [chr] EQL ctrl_z
		    THEN

			IF .inp_iob_addr NEQ in_iob
			THEN
			    BEGIN
			    $xpo_close (	!
				iob = .inp_iob_addr);	! Close require file
			    scn$set_in_unit (in_iob);	! switch back to main file
			    END
			ELSE
			    BEGIN
			    token [tok_len] = 0;
			    token [tok_type] = s_end_of_file;
			    LEAVE loop;
			    END

		    ELSE

			IF .stk [chr] EQL newline
			THEN
			    BEGIN
			    token [tok_type] = s_newline;

			    IF .in_file THEN stk [chr] = nxch ();

			    LEAVE loop;
			    END
			ELSE

			    IF .stk [chr] EQL form_feed
			    THEN
				BEGIN
				token [tok_type] = s_newpage;
				stk [chr] = nxch ();
				LEAVE loop;
				END;

		    stk [chr] = nxch ();
		    END;

		token [tok_cp] = CH$PLUS (.stk [cp], -1);

		SELECTONE .stk [chr] OF
		    SET

		    [%C'%'] :
			state = 1;

		    [%C'A' TO %C'Z', %C'a' TO %C'z', %C'$', %C'_'] :
			state = 3;

		    [%C'0' TO %C'9'] :
			state = 5;

		    [%C'!'] :
			state = 6;

		    [quote] :
			state = 7;
!<Blf/page>

		    [OTHERWISE] :
			BEGIN			! Delimiter or error

			LOCAL
			    type;

			CASE .stk [chr] FROM %C'(' TO %C'^' OF
			    SET

			    [%C'('] :
				type = s_lparen;

			    [%C')'] :
				type = s_rparen;

			    [%C'*'] :
				type = s_multiply;

			    [%C'+'] :
				type = s_plus;

			    [%C'-'] :
				type = s_minus;

			    [%C','] :
				type = s_comma;

			    [%C'.'] :
				type = s_dot;

			    [%C'/'] :
				type = s_divide;

			    [%C':'] :
				type = s_colon;

			    [%C';'] :
				type = s_semicolon;

			    [%C'<'] :
				type = s_langle;

			    [%C'='] :
				type = s_equal;

			    [%C'>'] :
				type = s_rangle;

			    [%C'['] :
				type = s_lbracket;

			    [%C']'] :
				type = s_rbracket;

			    [%C'^'] :
				type = s_circumflex;

			    [INRANGE] :
				type = 0;

			    [OUTRANGE] :
				type = 0;
			    TES;

			stk [chr] = nxch ();

			IF .type NEQ 0
			THEN
			    BEGIN
			    token [tok_len] = 1;
			    token [tok_type] = .type;
			    LEAVE loop;
			    END
			ELSE
			    utl$error (er_ill_sym);

			END;			! Delimiter or error
		    TES;

		END;				! State 0
!<Blf/page>

	    [1] :

		!+
		! State 1 has seen %. Either it starts an embedded
		! comment, a name, or is the % token.
		!_

		BEGIN
		stk [chr] = nxch ();

		IF .stk [chr] EQL %C'('
		THEN
		    BEGIN

		    !+
		    ! Start of an embedded comment
		    !-

		    state = 2;
		    token [tok_type] = start_embedded;
		    token [tok_len] = 2;
		    stk [chr] = nxch ();
		    LEAVE loop;
		    END
		ELSE

		    IF .stk [chr] GEQ %C'A' AND .stk [chr] LEQ %C'Z'	!
			OR .stk [chr] GEQ %C'a' AND .stk [chr] LEQ %C'z'	!
		    THEN
			state = 4
		    ELSE
			BEGIN
			token [tok_type] = s_percent;
			state = 0;
			token [tok_len] = 1;
			LEAVE loop;
			END;

		END;
!<Blf/page>

	    [2] :

		!+
		! State 2 has seen %(. It must find either a )% to
		! end the embedded comment, or a newline to end
		! this piece of it. If it finds the newline, it must
		! continue to scan for the )%.
		!-

		BEGIN

		LOCAL
		    last;

		!+
		! Scan for ")%" or newline
		!-

		last = %C'(';
		token [tok_cp] = CH$PLUS (.stk [cp], -1);	! Mark start of the field

		WHILE .stk [chr] NEQ eof DO
		    BEGIN

		    UNTIL .stk [chr] EQL %C'%' OR .stk [chr] EQL newline DO
			BEGIN
			last = .stk [chr];
			stk [chr] = nxch ();
			END;

		    IF .stk [chr] EQL %C'%' AND .last EQL %C')'
		    THEN
			BEGIN
			state = 0;
			token [tok_len] = CH$DIFF (.stk [cp], .token [tok_cp]);
			token [tok_type] = end_embedded;
			stk [chr] = nxch ();
			LEAVE loop;
			END
		    ELSE

			IF .stk [chr] EQL newline
			THEN
			    BEGIN
			    token [tok_type] = mid_embedded;
			    token [tok_len] = MAX (0, CH$DIFF (.stk [cp], .token [tok_cp]) - 1);
			    CH$FILL (%C' ', buf_len, CH$PTR (tok_buf));
			    CH$MOVE (.token [tok_len], .token [tok_cp], CH$PTR (tok_buf));
			    token [tok_cp] = CH$PTR (tok_buf);
			    stk [chr] = nxch ();
			    LEAVE loop;
			    END
			ELSE
			    stk [chr] = nxch ();	! Try next character

		    END;			! Of block in 'DO'

		END;				! Scan for ")%" or newline
!<Blf/page>

	    [3] :

		!+
		! State 3 has seen a character that can start
		! a name.
		!-

		BEGIN
		stk [chr] = nxch ();
		state = 4;
		END;

	    [4] :

		!+
		! State 4 is invoked to finish a name
		!-

		BEGIN

		WHILE .stk [chr] GEQ %C'A' AND .stk [chr] LEQ %C'Z'	!
		    OR .stk [chr] GEQ %C'a' AND .stk [chr] LEQ %C'z'	!
		    OR .stk [chr] GEQ %C'0' AND .stk [chr] LEQ %C'9'	!
		    OR .stk [chr] EQL %C'_'	!
		    OR .stk [chr] EQL %C'$'	!
		DO
		    stk [chr] = nxch ();

		token [tok_type] = s_name;
		token [tok_len] = MAX (0, CH$DIFF (.stk [cp], .token [tok_cp]) - 1);
		state = 0;
		LEAVE loop;
		END;				! State 4

	    [5] :

		!+
		! State 5 is invoked to finish a numeric literal
		!-

		BEGIN

		DO
		    stk [chr] = nxch ()
		WHILE .stk [chr] GEQ %C'0' AND .stk [chr] LEQ %C'9';

		state = 0;
		token [tok_len] = MAX (0, CH$DIFF (.stk [cp], .token [tok_cp]) - 1);
		token [tok_type] = s_numeric;
		LEAVE loop;
		END;				! State 5
!<Blf/page>

	    [6] :

		!+
		! State 6 is invoked to finish a comment
		!-

		BEGIN

		LOCAL
		    lcp,			! Local character pointer
		    comment_kind;

		state = 0;
		lcp = .token [tok_cp];

		IF (.stk [col] EQL 1) OR 	!
		    ((.stk [col] EQL 2) AND 	!
		    (CH$RCHAR (CH$PTR (stk [buf])) EQL form_feed))	! Comment starts in col 1
		THEN
		    comment_kind = full_line_com
		ELSE

		    IF .all_white
		    THEN
			BEGIN

			!+
			! Block comment or remark
			!-

			SELECTONE CH$RCHAR (CH$PLUS (.lcp, 1)) OF
			    SET

			    [%C'+'] :
				BEGIN
				end_com_pending = true;
				comment_kind = start_block_com;
				END;

			    [%C'-', %C'_'] :
				BEGIN
				end_com_pending = false;
				comment_kind = end_block_com;
				END;

			    [%C'.'] : 		! Always a remark
				comment_kind = remark;

			    [OTHERWISE] : 	! Nondescript

				IF .end_com_pending
				THEN
				    comment_kind = mid_block_com
				ELSE
				    BEGIN

				    !+
				    ! Guess whether remark or block comment
				    !-

				    LOCAL
					rem_col;

				    rem_col = ctl$switch (sw_rem_tabs)*8 + 1;

				    IF .rem_col - 16 LEQ .stk [col]	!
				    THEN
					comment_kind = remark
				    ELSE
					comment_kind = mid_block_com;

				    END;

			    TES;

			END
		    ELSE
			comment_kind = remark;

		DO
		    stk [chr] = nxch ()
		WHILE .stk [chr] NEQ newline;

		token [tok_len] = MAX (0, CH$DIFF (.stk [cp], .token [tok_cp]) - 1);
		token [tok_type] = .comment_kind;
		CH$FILL (%C' ', buf_len, CH$PTR (tok_buf));
		CH$MOVE (.token [tok_len], .token [tok_cp], CH$PTR (tok_buf));
		token [tok_cp] = CH$PTR (tok_buf);
		stk [chr] = nxch ();		! Triggers a read
		LEAVE loop;
		END;				! State 6
!<Blf/page>

	    [7] :

		!+
		! State 7 is invoked to finish a string
		!-

		BEGIN

		LOCAL
		    lstch;			! last char read

		!+
		! Find the end of a string. Ignore paired quotes found.
		!-

		lstch = .stk [chr];

		WHILE .stk [chr] NEQ eof DO
		    BEGIN

		    SELECTONE .stk [chr] OF
			SET

			[quote] :

			    IF .lstch EQL quote
			    THEN
				lstch = 0
			    ELSE
				BEGIN
				lstch = .stk [chr];
				token [tok_len] = MAX (0, CH$DIFF (.stk [cp], .token [tok_cp]));
				END;

			[newline] :
			    BEGIN

			    IF .lstch NEQ quote THEN utl$error (er_quote);

			    EXITLOOP;
			    END;

			[OTHERWISE] :
			    BEGIN

			    IF .lstch EQL quote THEN EXITLOOP;

			    lstch = .stk [chr];
			    END;
			TES;

		    stk [chr] = nxch ();
		    END;

		CH$MOVE (.token [tok_len], .token [tok_cp], CH$PTR (tok_buf));
		token [tok_cp] = CH$PTR (tok_buf);
		state = 0;
		token [tok_type] = s_string;
		LEAVE loop;
		END				! State 7
	    TES;

	END;					! FSM dispatch

    END;					! Loop
    all_white = .stk [col] LEQ 1;
    END;					! End of routine 'scn$getsym'

GLOBAL ROUTINE scn$init = 			!

!++
! Functional description:
!
!	This routine initializes the scanner
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	True for success, false for failure
!
! Side effects:
!
!	None
!
!--

    BEGIN
    stk [cp] = CH$PTR (stk [buf]);		! Set up char. pointer
    stk [len] = buf_len;
    mac_verbatim = plit_verbatim = exp_verbatim = false;	! Set formatting mode to automatic
    plit_count = 0;
    set_linebreak = line_broken = false;

    IF readaline () EQL -1 THEN RETURN false;	! Empty file

    !+
    !	Set internal state of the scanner
    !	To start looking for the first lexeme
    !-

    stk [chr] = nxch ();
    state = 0;
    RETURN true;
    END;					! End of routine 'scn$init'

GLOBAL ROUTINE scn$mbstrt (type) : NOVALUE =

!++
! Functional description:
!
!	This routine begins the non-formatted processing of a macro body
!	or a PLIT-body.
!	It is called when the preceding "=" has been found in the macro
!	definition. The rest of the line on which the "=" occurs is
!	treated as if it were a complete line in itself, to be sure
!	of finding the terminating "%" at the right time. To do this,
!	the rest of the line is overlaid onto the text already
!	processed and the buffer pointers and lengths recomputed.
!	Then all subsequent lines (including the present one) up to the
!	"%" are simply copied to the output file by "readaline" before
!	the next line is read in.
!	The final line of the macro- body is split after the
!	"%" is found in the routine which calls "scn$mfin"
!	(i.e. "do_macro" or "do_kwmacro".)
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	"buf" contains the input text line; "len" is its length;
!	"cp" and "endbuf" are current and final pointers into "buf".
!
! Implicit outputs:
!
!	The implicit inputs are reformatted and recomputed as
!	described above.
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN

    IF NOT scn$verbatim ()
    THEN
	BEGIN
	out$break ();				! Start macro-body on new line

	!+
	! Overlay the rest of the line of text on itself.
	! If empty, get the next line.
	!-

	IF .stk [rem] LSS 0
	THEN
	    readaline ()			! Get another line
	ELSE
	    BEGIN
	    ! Split the current line after the '='.
	    stk [cp] = CH$PLUS (.stk [cp], -1);	! Move cp left of next char
	    stk [len] = .stk [rem] + 1;
	    CH$MOVE (.stk [len], .stk [cp], CH$PTR (temp));	!
	    stk [cp] = CH$PTR (stk [buf]);
	    CH$MOVE (.stk [len], CH$PTR (temp), .stk [cp]);
	    stk [cp] = CH$PLUS (.stk [cp], 1);	! Restore cp relative position
	    END;

	END;

    IF .type EQL s_macro THEN mac_verbatim = true;

    IF .type EQL s_plit THEN plit_verbatim = true;

    END;					! End of routine 'scn$mbstrt'

GLOBAL ROUTINE scn$mfin (type) : NOVALUE = 	!

!++
! Functional description:
!
!	This routine is called when the "%" is found in the context
!	of a macro-body. Implicit non-formatting of the text is terminated.
!
!
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN
    out$ntbreak ();				! This call only resets pointers because
    						! we are still in verbatim mode.

    IF .type EQL s_macro THEN mac_verbatim = false;

    IF .type EQL s_plit THEN plit_verbatim = false;

    IF NOT scn$verbatim ()
    THEN
	BEGIN
	token [tok_len] = MAX (0, CH$DIFF (.stk [cp], CH$PTR (stk [buf])) - 1);	! Treat this line up to the %
	token [tok_cp] = CH$PTR (stk [buf]);	! as a single token
	out$tok ();				! and output it.
	token [tok_len] = 0;			! don't put it out twice
	END;

    END;					! End of routine 'scn$mfin'

GLOBAL ROUTINE scn$plit (n) : NOVALUE =

!++
! Functional description:
!
!	This routine alters the count of PLITs as they are entered
!	and exited, to help control non-formatting of PLIT bodies.
!
! Formal parameters:
!
!	n = + or - 1, as a plit is entered or exited.
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN
    plit_count = .plit_count + .n;
    ! Turn off plit_verbatim flag whenever count goes to zero.
    ! Turn on plit_verbatim at another point (at end of line).

    IF .plit_count EQL 0 AND .line_broken
    THEN
	BEGIN
	scn$mfin (s_plit);
	line_broken = false;
	END;

    ! If we are at the end of a line it's time to break it now.
    set_linebreak = .stk [rem] LSS 0 AND .n GEQ 0 AND .plit_count GTR 0;
    END;					! End of routine 'scn$plit'

GLOBAL ROUTINE scn$pop : NOVALUE = 		!

!++
! Functional description:
!
!	This routine restores the scanning context to its previous
!	state, at the point of the most recent call to scn$push.
!
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN
    stk = .STACK [.stack_level];

    IF .stack_level GTR 0 THEN stack_level = .stack_level - 1;

    END;					! End of routine 'scn$pop'

GLOBAL ROUTINE scn$push (arg) : NOVALUE = 	!

!++
! Functional description:
!
!	This routine provides a push-down stack for the pointers
!	to scanner state blocks. It is only three levels deep,
!	corresponding to the three possible sources of input:
!	1) primary input file, 2) require file, 3) within a
!	SYNONYM definition appearing in either of the above files.
!
! Formal parameters:
!
!	arg = a new state pointer
!
! Implicit inputs:
!
!	stk = the current state pointer
!
! Implicit outputs:
!
!	The new state pointer = arg
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN
    stack_level = .stack_level + 1;
    STACK [.stack_level] = .stk;
    stk = .arg;
    END;					! End of routine 'scn$push'

GLOBAL ROUTINE scn$set_in_unit (arg) : NOVALUE =

!++
! Functional description:
!
!	This routine permits control to direct the input stream from
!	the main file to a REQUIRE file, for the purpose of reading
!	further control directives. When the end of this file is
!	found, the unit is switched back by READALINE.
!	The current character and the input line are saved and restored
!	As the unit switches from one source to the other.
!
! Formal parameters:
!
!	arg = the unit number.
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN

    MAP
	inp_iob_addr : REF $xpo_iob ();

    IF .inp_iob_addr EQL req_iob AND .arg EQL req_iob
    THEN 					! Attempt to stack REQUIRES
	utl$error (er_file_spec);

    IF (inp_iob_addr = .arg) EQL req_iob
    THEN
	BEGIN
	! Back up one character to resume after alt. end-of-file
	! (Cf. Scn$getsym state 0 EOF handling.)
	stk [cp] = CH$PLUS (.stk [cp], -1);
	stk [col] = .stk [col] - 1;
	stk [rem] = .stk [rem] + 1;
	scn$push (alt_state);
	out$gag (true);				! Prevent file from being output
	END
    ELSE
	BEGIN
	scn$pop ();
	out$gag (false);
	END;

    END;					! End of routine 'scn$set_in_unit'

GLOBAL ROUTINE scn$strt_verb : NOVALUE = 	!

!++
! Functional description:
!
!	This routine is called from the scanner when a directive to
!	begin manual formatting is found.
!	Since the directive is a full-line comment, no action
!	to speak of is required here.
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	The comment !<BLF/noformat>
!	has appeared in the input stream.
!
! Implicit outputs:
!
!	None
!
! Routine value:
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN
    exp_verbatim = true;
    END;					! End of routine 'scn$strt_verb'

GLOBAL ROUTINE scn$verbatim = 			!

!++
! Functional description:
!
!	This functional routine returns the "or" of the two
!	verbatim (non-formatting) flags, thus is true if
!	formatting has been suppressed.
! Formal parameters:
!
!	None
!
! Implicit inputs:
!
!	None
!
! Implicit outputs:
!
!	None
!
! Routine value:
!    1 or 0
!
!
!	None
!
! Side effects:
!
!	None
!
!--

    BEGIN
    RETURN .mac_verbatim OR .exp_verbatim OR .plit_verbatim;
    END;					! End of routine 'scn$verbatim'

%SBTTL 'Final page of SCANNR.BLI'
END						! End of module 'scannr'

ELUDOM