!<BLF/REQUIRE 'USR_LIBRARY:PRETTY'>
%TITLE 'LASER_SYMBIONT'
MODULE laser_symbiont (IDENT = 'V001-01',	! File: LASER_SYMBIONT.BLI
		MAIN = ls_main
		) =
BEGIN

!++
!
! FACILITY:	User modified print symbiont
!
! ABSTRACT:	This user modified print symbiont will prevent the laser printer
!		from ejecting a blank page at the beginning of each job, when the
!		symbiont first starts up, and when the first character of a file
!		is a form feed (listing files).
!
! ENVIRONMENT:	VAX/VMS, user mode
!
! AUTHOR:	Brian K Catlin
!
! CREATED:	9-JAN-1990
!
! MODIFICATION
! HISTORY:
!
!	V001-1	Brian K Catlin, James A Gray		9-JAN-1990
!		Original version.
!
!--


%SBTTL 'Declarations'

!+
! SWITCHES:
!-

SWITCHES ADDRESSING_MODE (EXTERNAL = GENERAL, NONEXTERNAL = WORD_RELATIVE);

!+
! LINKAGE/GLOBAL REGISTERS:
!-

!	None.

!+
! LINKAGES:
!-

!	None.

!+
! INCLUDE FILES:
!-

LIBRARY 'SYS$LIBRARY:LIB';			! VMS executive macros/symbols

LIBRARY 'USR_LIBRARY:USRLIB';			! Our macros/symbols

REQUIRE 'LASER_DEFS';				! Local definitions

!+
! TABLE OF CONTENTS:
!-

FORWARD ROUTINE
    ls_main,					! Main entrypoint into the symbiont
    ls_output_filter,				! Filters output stream
    ls_page_setup;				! Handles page setup

!+
! MACROS:
!-

!	None.

!+
! FIELDS:
!-

!	None.

!+
! STRUCTURES:
!-

!	None.

!+
! PROGRAM SECTION DECLARATIONS:
!-

!	None.

!+
! EQUATED SYMBOLS:
!-

LITERAL
    k_false = 0,
    k_true = 1;

!+
! OWN (R/O) STORAGE:
!-

!+
! Build a string descriptor that points to a string containing a carriage return
! and a form feed.  This is the string we will strip from the beginning of the job.
!-

BIND
    ls_r_crff = $descriptor (%CHAR (smg$k_trm_cr), %CHAR (smg$k_trm_ff)) : BLOCK [, BYTE];

!+
! OWN (R/W) STORAGE:
!-

!	None.

!+
! BUILTIN DECLARATIONS:
!-

BUILTIN
    TESTBITCS;					! Effectively a BBCS instruction

!+
! EXTERNAL ROUTINES:
!-

EXTERNAL ROUTINE
    psm$page_setup,				! VMS symbiont page setup
    psm$print,					! Tell the VMS print symbiont to processing
    psm$read_item_dx,				! Read item from VMS symbiont
    psm$replace,				! Replace a standard VMS print symbiont routine
    str$analyze_sdesc,				! Analyze string descriptor
    str$copy_r;					! Copy a string by reference

!+
! EXTERNAL REFERENCES:
!-

EXTERNAL
    psm$_eof,					! End of input
    psm$_funnotsup;				! Function not supported


%SBTTL 'LS_MAIN - Laser Symbiont main entry point'
ROUTINE ls_main =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine gains control from VMS and initializes the print symbiont.
!
! ENVIRONMENT:
!
!	All access modes, AST reentrant
!
! CALLING SEQUENCE:
!
!	Called by the image activator (we're a detached process)
!
! LINKAGE:
!
!	CALL
!
! FORMAL PARAMETERS:
!
!	None.
!
! IMPLICIT INPUTS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! COMPLETION CODES:
!
!	SS$_NORMAL	Normal successful completion
!	Anything returned by PSM$PRINT, or PSM$PRINT
!
! SIDE EFFECTS:
!
!	None.
!
!--

    BEGIN

    LOCAL
	l_status : LONG;

    !+
    ! Replace some routines in the standard symbiont.
    !-

    IF (l_status = psm$replace (%REF (psm$k_output_filter), ls_output_filter))
    THEN
	BEGIN

	IF (l_status = psm$replace (%REF (psm$k_page_setup), ls_page_setup))
	THEN
	    BEGIN

	    !+
	    ! Start the symbiont.  Only returns if symbiont is stopped or a fatal error
	    ! has occurred.
	    !-

	    l_status = psm$print (%REF (16), 0, %REF (sctx_s_sctxdef));
	    END;

	END;

    !+
    ! If bad status, then signal it.
    !-

    IF NOT (.l_status)
    THEN
	BEGIN
	SIGNAL (.l_status);
	END;

    RETURN (.l_status);
    END;					! End of routine LS_MAIN

%SBTTL 'LS_OUTPUT_FILTER - Filter the output stream'
ROUTINE ls_output_filter (			!
    l_request_id : REF VECTOR [, LONG], 	!
    r_sctx : REF sctxdef, 			!
    l_function : REF VECTOR [, LONG], 		!
    r_input_desc : REF BLOCK [, BYTE], 		!
    l_input_arg : REF VECTOR [, LONG], 		!
    r_output_desc : REF BLOCK [, BYTE], 	!
    l_output_arg : REF VECTOR [, LONG]		!
    ) =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine replaces the PSM$OUTPUT_FILTER routine.  In the normal print
!	symbiont, there is no output filter, (or input filter for that matter),
!	but we need one here to remove the CR/FF sequences.  The output filter is
!	called between the format routine and the output routine to modify the
!	output buffer prior to being passed to the output routine.
!
! ENVIRONMENT:
!
!	All access modes, AST reentrant
!
! CALLING SEQUENCE:
!
!	Called by the VMS print symbiont
!
! LINKAGE:
!
!	CALL
!
! FORMAL PARAMETERS:
!
!	l_request_id
!		Request identifier supplied by the symbiont
!
!	r_sctx
!		User context area
!
!	l_function
!		Function code indicating function to be performed by this routine
!
!	r_input_desc
!		Input buffer
!
!	l_input_arg
!		Input argument
!
!	r_output_desc
!		Output buffer
!
!	l_output_arg
!		Output argument
!
! IMPLICIT INPUTS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! COMPLETION CODES:
!
!	SS$_NORMAL	Normal successful completion
!	PSM$_FUNNOTSUP	Function not supported
!
! SIDE EFFECTS:
!
!	None.
!
!--

    BEGIN

    LOCAL
	a_pointer : LONG,
	l_status : LONG,
	w_length : WORD;

    !+
    ! Decide what to do based on the function code passed to us by the VMS print symbiont.
    !-

    SELECTONE (.l_function [0]) OF
	SET

	!+
	! Process a chunk to be sent to the printer.
	!-

	[psm$k_format] :
	    BEGIN

	    !+
	    ! Get the address and length of the chunk to be written.
	    !-

	    str$analyze_sdesc (r_input_desc [0, 0, 0, 0], w_length, a_pointer);

	    !+
	    ! If this is the first write since the symbiont was started, then check if the first
	    ! characters in the chunk match the CR/FF sequence and if so then remove them from the
	    ! record being written.  This prevents an unnecessary blank page from being output each
	    ! time the symbiont is started.
	    !-

	    IF (.w_length GEQU .ls_r_crff [dsc$w_length])
	    THEN
		BEGIN

		IF (TESTBITCS (r_sctx [sctx_v_stream_crff_ignored]))
		THEN
		    BEGIN

		    IF (CH$EQL (.ls_r_crff [dsc$w_length], .a_pointer, .ls_r_crff [dsc$w_length],
			    .ls_r_crff [dsc$a_pointer]))
		    THEN
			BEGIN

			!+
			! Skip past the CR/FF characters.
			!-

			a_pointer = .a_pointer + .ls_r_crff [dsc$w_length];
			w_length = .w_length - .ls_r_crff [dsc$w_length];
			END;

		    END;

		END;

	    !+
	    ! If this is the first write for this job, then check if the last characters in the chunk
	    ! match the CR/FF sequence and if so then remove them from the record being written.  This
	    ! prevents an unnecessary blank page from being output.
	    !-

	    IF (.w_length GEQU .ls_r_crff [dsc$w_length])
	    THEN
		BEGIN

		IF (TESTBITCS (r_sctx [sctx_v_job_crff_ignored]))
		THEN
		    BEGIN

		    IF (CH$EQL (.ls_r_crff [dsc$w_length],
			    .a_pointer + .w_length - .ls_r_crff [dsc$w_length], .ls_r_crff [dsc$w_length],
			    .ls_r_crff [dsc$a_pointer]))
		    THEN
			BEGIN

			!+
			! Remove the trailing CR/FF characters.
			!-

			w_length = .w_length - .ls_r_crff [dsc$w_length];
			END;

		    END
		ELSE
		    BEGIN

		    !+
		    ! If we're printing a listing file (.LIS - possibly generated by a compiler), then there
		    ! will be a CR/FF as the first characters on the first line so remove them as well so we
		    ! don't get a blank page at the beginning of every listing file.  The FF is part of the
		    ! listing file, and a CR is prefixed by the main format routine.
		    !-

		    IF (TESTBITCS (r_sctx [sctx_v_first_crff_ignored]))
		    THEN
			BEGIN

			IF (CH$EQL (.ls_r_crff [dsc$w_length], .a_pointer, .ls_r_crff [dsc$w_length],
				.ls_r_crff [dsc$a_pointer]))
			THEN
			    BEGIN

			    !+
			    ! Skip past the CR/FF characters.
			    !-

			    a_pointer = .a_pointer + .ls_r_crff [dsc$w_length];
			    w_length = .w_length - .ls_r_crff [dsc$w_length];
			    END;

			END;

		    END;

		END;

	    !+
	    ! Copy resultant record to the output buffer.
	    !-

	    IF (l_status = str$copy_r (r_output_desc [0, 0, 0, 0], w_length, .a_pointer))
	    THEN
		BEGIN
		l_status = ss$_normal;
		END;

	    END;

	!+
	! No other functions are supported.
	!-

	[OTHERWISE] :
	    BEGIN
	    l_status = psm$_funnotsup;
	    END;
	TES;

    RETURN (.l_status);
    END;					! End of routine LS_OUTPUT_FILTER

%SBTTL 'LS_PAGE_SETUP - Handles page setup'
ROUTINE ls_page_setup (				!
    l_request_id : REF VECTOR [, LONG], 	!
    r_sctx : REF sctxdef, 			!
    l_function : REF VECTOR [, LONG], 		!
    r_func_desc : REF BLOCK [, BYTE], 		!
    l_func_arg : REF VECTOR [, LONG]		!
    ) =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine replaces the PSM$PAGE_SETUP routine.  This routine will be
!	called at the beginning of each page, job, task, and stream.  This
!	routine is used to reset the state variables that are used by the output
!	filter routine (LS_OUTPUT_FILTER).  After the state variables have been
!	set, the standard VMS page setup routine will be called.
!
! ENVIRONMENT:
!
!	All access modes, AST reentrant
!
! CALLING SEQUENCE:
!
!	Called by the print symbiont
!
! LINKAGE:
!
!	CALL
!
! FORMAL PARAMETERS:
!
!	l_request_id
!		Request identifier supplied by the symbiont
!
!	r_sctx
!		User context area
!
!	l_function
!		Function code indicating function to be performed by this routine
!
!	r_func_desc
!		Function  buffer
!
!	l_func_arg
!		Function argument
!
! IMPLICIT INPUTS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! COMPLETION CODES:
!
!	SS$_NORMAL	Normal successful completion
!	Anything returned by PSM$PAGE_SETUP
!
! SIDE EFFECTS:
!
!	None.
!
!--

    BEGIN

    LOCAL
	l_status : LONG;

    !+
    ! Decide what to do based on the function code passed to us by VMS symbiont.
    !-

    SELECTONE (.l_function [0]) OF
	SET

	!+
	! Processing to be done when starting a new stream.
	!-

	[psm$k_start_stream] :
	    BEGIN

	    !+
	    ! Initialize values in the stream context block that are needed
	    ! before a task is even started.
	    !-

	    r_sctx [sctx_v_stream_crff_ignored] = k_false;
	    l_status = ss$_normal;
	    END;

	!+
	! Processing to do when starting a new task.
	!-

	[psm$k_start_task] :
	    BEGIN

	    !+
	    ! Initialize values in the stream context block that are needed
	    ! at the beginning of each task.
	    !-

	    r_sctx [sctx_v_job_crff_ignored] = k_false;
	    r_sctx [sctx_v_first_crff_ignored] = k_false;
	    l_status = ss$_normal;
	    END;

	!+
	! No other functions supported.
	!-

	[OTHERWISE] :
	    BEGIN
	    l_status = ss$_normal;
	    END;
	TES;

    !+
    ! If everything up to this point was processed OK, then call the VMS symbiont supplied
    ! page setup routine so it can do its normal processing.  The only reason that this
    ! routine is replaced at all is so that we can get control at the beginning of each task.
    !-

    IF (.l_status)
    THEN
	BEGIN
	l_status = psm$page_setup (l_request_id [0], r_sctx [0, 0, 0, 0], l_function [0],
	    r_func_desc [0, 0,
		0, 0], l_func_arg [0]);
	END;

    RETURN (.l_status);
    END;					! End of routine LS_PAGE_SETUP
END						! End of module LASER_SYMBIONT

ELUDOM