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

MODULE RESFIL	(
		IDENT = '1',
		%IF
		    %BLISS(BLISS32)
		%THEN
		    LANGUAGE(BLISS32),
		    ADDRESSING_MODE(EXTERNAL=LONG_RELATIVE,
				    NONEXTERNAL=LONG_RELATIVE)
		%ELSE
		    LANGUAGE(BLISS36)
		%FI
		) =
BEGIN

!
!			  COPYRIGHT (C) 1982, 1983 BY
!	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED
! ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE
! INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR  ANY  OTHER
! COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
! OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY
! TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT  NOTICE
! AND  SHOULD  NOT  BE  CONSTRUED  AS  A COMMITMENT BY DIGITAL EQUIPMENT
! CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF  ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!

!++
! FACILITY:	CMS Library Processor
!
! ABSTRACT:
!
!	Get a file from the specified library and place it in the user's
!	area along with any corrections or changes that are current.
!
! ENVIRONMENT:	VAX/VMS, DS-20
!
! AUTHOR: D. Knight , CREATION DATE: 20-Nov-78
!
!--

!++
!				General Description
!
!	RESFIL is called by RESERVE to process the actual text for FETCH,
!	RESERVE, ANNOTATE and the merge function.  RESERVE and FETCH are
!	handled identically, the text is simply delivered to the user's
!	working area.  ANNOTATE and merge have the text modified.  ANNOTATE
!	adds the generation numbers of each line and formats the text in
!	a listable format.  The merge function simply places the
!	generation number on each line as required.
!
!				File structures
!
!	As described in RESERVE.
!
!--

!
! TABLE OF CONTENTS
!

FORWARD ROUTINE
	RESFIL,				!Top level control loop
	GET_LIN,			!Get a line of text from the file in the library
	HDR: NOVALUE,			!Output an ANNOTATE header line
	OUTTXT : NOVALUE,		!Output text (open output file if needed)
	SETINP : NOVALUE,		!Set up the input file to be used
	SETOUT : NOVALUE,		!Set up the output file to be used
	TERMINATE: NOVALUE,		!Close all files
	WRT_LINE: NOVALUE;		!Output a line (include any source annotations)

!
! INCLUDE FILES:
!

%if
    %bliss(bliss32)
%then
    library 'sys$library:starlet';
%else
    require 'jsys:';
%fi

LIBRARY 'XPORT:';

REQUIRE 'SCONFG:';

REQUIRE 'BLISSX:';

REQUIRE 'COMUSR:';

REQUIRE 'HOSUSR:';

!
! MACROS:
!

MACRO
	IOB$H_RESULTANT=$SUB_FIELD(IOB$T_RESULTANT,STR$H_LENGTH) %,
	IOB$A_RESULTANT=$SUB_FIELD(IOB$T_RESULTANT,STR$A_POINTER) %,
	STG(L,M) = OUTTXT(CH$PTR(UPLIT(L)),%CHARCOUNT(L),M) %;

!
! EQUATED SYMBOLS:
!

GLOBAL LITERAL
	MAX_LINES=57;			!Page size - 3

!
! OWN STORAGE:
!

GLOBAL

	L_CNTR ;			!Line counter used by HDR
    	
    	

OWN
	FIL_LEN,
	FIL_PTR,
	FIRST_CALL : INITIAL(0),
	$IO_BLOCK(INPUT),		!Input file IOB
	I_OPN,				!Input file is open
	O_OPN,				!Output file is open
	PAG_NUM,			!Holds the current page number
	S_L_PTR,
	SEQ_FLG,			!TRUE if sequenced file is to be produced
					!FALSE if not.
	SEQ_SEEN;			!TRUE if actual sequence numbers seen
					!FALSE if not

!
! EXTERNAL REFERENCES:
!

external literal
	s_invcksum,			!CRC's don't match
	s_isthere,			!file already exists
	s_nocksum, 			!No CRC detected
	s_onoopen,			!cannot open output file
	s_useverrec;			!use verify/recover

!Merge control
EXTERNAL
	MERGE,
	MRG_BRNCH,
	MRG_MAIN,
	NO_MRG;

EXTERNAL
    	CHRLEN,				!Length of chronology string
	CHRONO,				!Chronology flag
	CMD,				!Which command
    	FETSTS,				! Status to indicate special completion
    					! typically in the case of a warning
    					! or alternate success
	f_perf_crc,			! Perform CRC calculation if true ( In OUTSTG, else ignore)
	LGEN,				!Current generation of the line
	LGEN_L,				!Length of current generation
	MAX_G_LGT,			!Maximum possible generation length
	NAME_PTR,
	NAME_SIZ,
	NOTES,				!Source annotation flag
	NOTLEN,				!Source audit pattern string length
	ONPATH,				!Current operation is on correct generation path
	OUTPUT_IOB : $XPO_IOB(),
	PAT_FIL,			!Left margin fill count
	PAT_GEN,			!True if generation is needed in audit mark
	PAT_LS,				!Left part of pattern
	PAT_LLS,			!Length of left part
	PATPOS,				!Position in line, 0 = left margin
	PAT_RS,				!Right part of pattern
	PAT_LRS,			!Length of right part
	PLUS_GET,			!Plus operator appeared in normal generation expression
	PLUS_MRG;			!Plus operator appeared in merge generation expression

EXTERNAL ROUTINE
	aschex,				!Convert ASCII to hex
	BADLIB,
	BADXPO,
	BUG,
	BYE,				!Exit with message
	CHKGEN,
	CMPGEN,
	crccalc,
	crctable,
	DATTIM,
	DECASC,				!Convert decimal to ASCII
	ERSXPO,
	GEN_SETUP,
	GET_LXM,			!Get text lexeme
	GET_MLINE,
	NATEQL,				! Check name and type of file spec
	OUTNUM,
	OUTNMZ,				!Output numeric filled value
	OUTSTG,
	PAT_SETUP,
	say,
    	sysmsg,
	test_gen,			!check for common ancestor generation
    	VERNUM ;

GLOBAL ROUTINE RESFIL (FIL_NAM_LGT,FIL_NAM_STR,G_LEN,G_PTR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Generate a new file from the master file and a list of corrections.
!
! FORMAL PARAMETERS:
!
!	FIL_NAM_LGT - length of file name to be processed
!	FIL_NAM_STR - pointer to file name to be processed
!	G_LEN - length of generation to be retrieved
!	G_PTR - pointer to generation to be retrieved
!
! IMPLICIT INPUTS:
!
!	NONE.
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	TRUE - success
!	FALSE - failure
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    LOCAL
	count,
	CUR_DEL : VECTOR[CH$ALLOCATION(50)],
	CUR_DEL_LEN,
	CUR_DEL_FLG,
	found_crc ,
	GEN_BUF : VECTOR[CH$ALLOCATION(50)],
	GEN_LGT,
	KEEP,
	LIN_NUM,
	SEQ_N,
	total,
	TEXT_SEEN;

    FIL_LEN=.FIL_NAM_LGT;
    FIL_PTR=.FIL_NAM_STR;

    !This is done to make sure any errors are reported as user errors
    !only for the first file of an element.  If errors occur after the
    !first, they ARE bugs or errors in the library.
    FIRST_CALL=.FIRST_CALL+1;

    !Assume sequencing is off
    SEQ_FLG=FALSE;
    SEQ_SEEN=FALSE;

    !First text line has not yet been seen (don't include header lines)
    TEXT_SEEN=FALSE;

    !Point to generation information
    CH$MOVE(.G_LEN,.G_PTR,CH$PTR(GEN_BUF));
    GEN_LGT=.G_LEN;

    !Open input file (the output file opening must be postponed
    !until we know whether sequencing is to be performed)
    SETINP();

    !No output file yet
    O_OPN=FALSE;

    !Default line number to be printed on annotated listing
    LIN_NUM=0;
    SEQ_N=0;

    !The page number starts with one
    PAG_NUM=1;

    !No deletion mark has yet been postponed
    CUR_DEL_FLG=FALSE;

    !Initialize generation stack
    GEN_SETUP(KEEP);

    !Set up source file pattern
    PAT_SETUP();

    ! Zero CRC accumulators
    count = 0;
    total = 0;
    found_crc = false;

    ! Tell OUTSTG not to calculate CRC if called from here
    f_perf_crc = false;
    
    ! Setup CRC polynomial table
    crctable();

    !Now process the complete file
    REPEAT
	BEGIN

	LOCAL
	    comp,
	    S_SIZ,
	    crc_count,
	    TAG;

	!Read a line
	s_siz = get_lin();

        ! Calculate the crc of the line (if we haven't hit EOF)
	! But first see if this is the CRC line itself
	if .s_siz neq eof 
	then
	    begin
     	    IF
	    	ch$eql(4,ch$ptr(uplit('*/C:')),4,.s_l_ptr)
	    then
		begin
		found_crc = true ;
		if  .merge neq mrg_brnch
		then
	    	    begin
	    	    local
		        len,
		        ptr;
	    	    len = .s_siz - 4 ;
	    	    ptr = ch$plus(.s_l_ptr, 4);
	    	    crc_count = aschex(ptr, len) ;
	    	    s_siz = eof;
	    	    end
		else
		    s_siz = eof
		end
	    else
		if .merge neq mrg_brnch
		then
	    	    begin
	    	    count = 0;
	    	    count = crccalc(.s_siz, .s_l_ptr);
	    	    total = .total + .count;
	    	    end ;
	end ;
	

	!Quit at end of file
	IF
	    .s_siz eql eof
	THEN
	    BEGIN

	    !If no output file is open yet, open it.
	    !This makes sure that if the user gave us a
	    !zero length file, he will get back a zero length file
	    !if he asks for it again.
	    IF
		NOT .O_OPN
	    THEN
		SETOUT();

	    !Output the postponed deletion, if any
	    IF
		.CUR_DEL_FLG
	    THEN
		BEGIN
		if
		    test_gen(ch$ptr(cur_del),.cur_del_len)
		then
		    !don't output the deletion unless it is the
		    ! descendant of the common ancestor generation
		    begin
		    STG('*',FALSE);
		    OUTTXT(CH$PTR(CUR_DEL),.CUR_DEL_LEN,FALSE);
		    STG('	',TRUE)
		    end
		END;

	    if not .found_crc
	    then
		sysmsg(s_nocksum,cat((.fil_len,.fil_ptr),
					' has no checksum'),0)
	    else
		if .crc_count neq .total
		    and .merge neq mrg_brnch
		then
		    sysmsg(s_invcksum,cat((.fil_len,.fil_ptr),
				' has an invalid checksum'),0);

	    TERMINATE();

	    RETURN G_OK
	    END;

	!Get tag character
	TAG=CH$RCHAR_A(S_L_PTR);
	S_SIZ=.S_SIZ-1;

	!See if it is a control command
	IF
	    .TAG EQL %C'*'
	THEN
	    !Command
	    BEGIN
	    !See if there is a master control record
	    !For now it is only necessary to check for a /S,
	    !meaning sequencing is in effect.
	    IF
		CH$EQL(2,CH$PTR(UPLIT('/S')),.S_SIZ,.S_L_PTR)
	    THEN
		!Sequencing is in effect
		BEGIN
		IF
		    .TEXT_SEEN
		THEN
		    !Cannot handle a file which is half-sequenced
		    !The /S must be before ANY text.
		    BADLIB(LIT('/S is out of order'));
		SEQ_FLG=TRUE
		END
	    ELSE
		CHKGEN(S_L_PTR,.S_SIZ,KEEP,CH$PTR(GEN_BUF),.GEN_LGT)
	    END
	ELSE
	!A data line has a blank control character
	!Output the line without the blank
	IF
	    .TAG EQL %C' '
	THEN
	    !Data line
	    BEGIN

	    TEXT_SEEN=TRUE;
	    IF
		.KEEP
	    THEN
		BEGIN

		!Get the line number and the text separated
		IF
		    .SEQ_FLG
		THEN
		    BEGIN
		    !Get the line and its sequence number
		    SEQ_N=GET_MLINE(.G_LEN,.G_PTR,S_L_PTR,S_SIZ);

		!If the line number is non-zero, the generation is sequenced
		    IF
		    	.SEQ_N NEQ -1
		    THEN
		    	SEQ_SEEN=TRUE;
		    END;

		IF
		    .CMD EQL K_ANNOTATE_COM OR
		    .MERGE NEQ NO_MRG
		THEN
		    BEGIN

		    !Output the postponed deletion, if any
		    !and if it is not a simple replace
		    IF
			.CUR_DEL_FLG AND
			CH$NEQ(.CUR_DEL_LEN,CH$PTR(CUR_DEL),.LGEN_L,.LGEN)
		    THEN
			BEGIN
			if
			    test_gen(ch$ptr(cur_del),.cur_del_len)
			then
			    !don't output the deletion unless it is the
			    ! descendant of the common ancestor generation
			    begin
			    STG('*',FALSE);
			    OUTTXT(CH$PTR(CUR_DEL),.CUR_DEL_LEN,FALSE);
			    STG('	',TRUE)
			    end
			END;

		    CUR_DEL_FLG=FALSE;

		    IF
			.CMD EQL K_ANNOTATE_COM
		    THEN
			BEGIN
			IF
			    CH$RCHAR(.S_L_PTR) EQL FORM_FEED AND
			    .S_SIZ EQL 1
			THEN
			    BEGIN

			    PAG_NUM=.PAG_NUM+1;

			    !Tell user about break
			    IF
				.LGEN_L NEQ 0
			    THEN
				OUTTXT(.LGEN,.LGEN_L,FALSE);

			    !Advance line number for unsequenced file
			    IF
				NOT .SEQ_SEEN
			    THEN
				LIN_NUM=.LIN_NUM+1;

			    STG('		<PAGE>',TRUE);
			    HDR(.NAME_PTR,.NAME_SIZ,.FIL_NAM_STR,.FIL_NAM_LGT)
			    END
			ELSE
			    BEGIN

			    LOCAL
				SEQ_BUF : VECTOR[CH$ALLOCATION(SEQ_NUM_SIZE)],
				SEQ_LEN;

			    !See if enough room is on the page
			    IF
				.L_CNTR GEQ MAX_LINES
			    THEN
				HDR(.NAME_PTR,.NAME_SIZ,.FIL_NAM_STR,.FIL_NAM_LGT);

			    IF
				.LGEN_L NEQ 0
			    THEN
				OUTTXT(.LGEN,.LGEN_L,FALSE);

			    STG('	',FALSE);

			    IF
				NOT .SEQ_SEEN
			    THEN
				!Unsequenced file, put out simple line number
				BEGIN
				LIN_NUM=.LIN_NUM+1;
				OUTNUM(.LIN_NUM,FALSE)
				END
			    ELSE
				!Generate zero filled value for sequenced file
				OUTNMZ(.SEQ_N,SEQ_NUM_SIZE,FALSE);

			    STG('	',FALSE);

			    !Now output the line proper
			    L_CNTR=.L_CNTR+1;
			    OUTTXT(.S_L_PTR,.S_SIZ,TRUE)
			    END
			END
		    ELSE
			BEGIN
			!Put out the generation expression if non-zero
			IF
			    .LGEN_L NEQ 0
			THEN
			    begin
			    if
				test_gen(.lgen,.lgen_l)
			    then
				!don't put out the generation value unless
				! it is the descendant of the common ancestor,
				! since any generation at the common ancestor
				! or before is treated the same
				OUTTXT(.LGEN,.LGEN_L,FALSE)
			    end;

			STG('	',FALSE);

			OUTPUT_IOB[IOB$G_SEQ_NUMB]=.SEQ_N;
			OUTTXT(.S_L_PTR,.S_SIZ,TRUE)
			END
		    END
		ELSE
		    BEGIN
		    OUTPUT_IOB[IOB$G_SEQ_NUMB]=.SEQ_N;
		    WRT_LINE(.S_SIZ,.S_L_PTR)
		    END
		END
	    ELSE
		!See if this deletion is occurring during a merge
		BEGIN
		IF
		    .MERGE NEQ NO_MRG AND
		    .ONPATH
		THEN
		    !Mark the deletion
		    BEGIN
		    IF
			NOT .CUR_DEL_FLG
		    THEN
			!No postponed entries yet
			BEGIN
			CH$MOVE(.LGEN_L,.LGEN,CH$PTR(CUR_DEL));
			CUR_DEL_LEN=.LGEN_L;
			CUR_DEL_FLG=TRUE
			END
		    ELSE
		    IF
			CH$NEQ(.LGEN_L,.LGEN,.CUR_DEL_LEN,CH$PTR(CUR_DEL))
		    THEN
			!Postponed entry doesn't match current entry
			BEGIN
			if
			    test_gen(ch$ptr(cur_del),.cur_del_len)
			then
			    !don't put out a deletion for any
			    ! generation at the common ancestor
			    ! or before, since later generations
			    ! are the only ones that are significant
			    begin
			    STG('*',FALSE);
			    OUTTXT(CH$PTR(CUR_DEL),.CUR_DEL_LEN,FALSE);
			    STG('	',TRUE)
			    end;

			!Now postpone the new one
			CH$MOVE(.LGEN_L,.LGEN,CH$PTR(CUR_DEL));
			CUR_DEL_LEN=.LGEN_L

			END
		    END
		END
	    END
	ELSE
	!Anything left over in column 1 other than "+" is an error
	IF
	    .TAG NEQ %C'+'
	THEN
	    !Error
	    BADLIB(LIT('Illegal control record'));

	!Comment lines (+) are discarded automatically

	END;

    !Just in case
    BUG(LIT('Cannot get here (RESFIL)'))

    END;				!End of RESFIL

ROUTINE GET_LIN =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Get a source line
!
! FORMAL PARAMETERS:
!
!	NONE.
!
! IMPLICIT INPUTS:
!
!	The input file is already open.
!
! IMPLICIT OUTPUTS:
!
!	S_L_PTR - Character pointer to start of line
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	length of line, -1 if EOF.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    LOCAL
	COMP;

    !Get a line of input and the completion value
    COMP=$step_get(IOB=INPUT_IOB,FAILURE=0);

    !Point to the line
    S_L_PTR=.INPUT_IOB[IOB$A_STRING];

    IF
	.COMP
    THEN
	.INPUT_IOB[IOB$H_STRING]
    ELSE
	-1

    END;				!End of GET_LIN

GLOBAL ROUTINE HDR (ELM_PTR,ELM_LGT,FIL_PTR,FIL_LGT) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Output a page header
!
! FORMAL PARAMETERS:
!
!	ELM_PTR - pointer to element name
!	ELM_LGT - length of element name
!	FIL_PTR - pointer to file name
!	FIL_LGT - length of file name
!
! IMPLICIT INPUTS:
!
!	NONE.
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    LOCAL
	DBUF : VECTOR[CH$ALLOCATION(40)],
	DLGT;

    L_CNTR=0;

    !Put out header
    OUTTXT(CH$PTR(UPLIT(%STRING(%CHAR(12)))),1,TRUE);
    STG(%string(' ',fac_name,' annotated listing for element '),FALSE);
    OUTTXT(.ELM_PTR,.ELM_LGT,FALSE);
    STG(' File ',FALSE);
    OUTTXT(.FIL_PTR,.FIL_LGT,FALSE);
    STG(' ',FALSE);
    DLGT=DATTIM(DBUF);
    OUTTXT(CH$PTR(DBUF),.DLGT,FALSE);

    !Put out special page number if sequencing is enabled
    IF
	.SEQ_SEEN
    THEN
	BEGIN
	STG(' Page ',FALSE);
	OUTNUM(.PAG_NUM,TRUE)
	END
    ELSE
	OUTTXT(0,0,TRUE);

    !Put out 2 blank lines
    INCR I FROM 1 TO 2 DO OUTTXT(0,0,TRUE);

    END;				!End of HDR

GLOBAL ROUTINE OUTTXT (PTR,LEN,TERM) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Output a line of text (open the output file if not already open)
!
! FORMAL PARAMETERS:
!
!	PTR - pointer to line
!	LEN - length of line
!	TERM - type of termination
!
! IMPLICIT INPUTS:
!
!	NONE.
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    !Make sure output file is open
    IF
	.CMD NEQ K_ANNOTATE_COM AND
	NOT .O_OPN
    THEN
	SETOUT();

    OUTSTG(.PTR,.LEN,.TERM)

    END;				!End of OUTTXT

ROUTINE SETINP : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Open the files and do any required initialization.
!
! FORMAL PARAMETERS:
!
!
! IMPLICIT INPUTS:
!
!	FIL_LEN - length of file name
!	FIL_PTR - pointer to file name
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    LOCAL
	FIL: VECTOR[CH$ALLOCATION(EXTENDED_FILE_SPEC)],
	FIL_P,
	FIL_SIZ,
	STS;

    I_OPN=FALSE;

    FIL_P=CH$PTR(FIL);
    FIL_P=CH$MOVE(%CHARCOUNT(LIB),CH$PTR(UPLIT(LIB)),.FIL_P);
    FIL_P=CH$MOVE(.FIL_LEN,.FIL_PTR,.FIL_P);

    FIL_SIZ=CH$DIFF(.FIL_P,CH$PTR(FIL));

    STS=$STEP_OPEN(IOB=INPUT_IOB,FILE_SPEC=(.FIL_SIZ,CH$PTR(FIL)),
		    OPTIONS=INPUT,FAILURE=0);
    IF
	NOT .STS
    THEN
	BADXPO(.STS,CAT(('Cannot open master file '),(.FIL_SIZ,CH$PTR(FIL))));

    I_OPN=TRUE

    END;				!End of SETINP

ROUTINE SETOUT : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Open the files and do any required initialization.
!
! FORMAL PARAMETERS:
!
!	NONE.
!
! IMPLICIT INPUTS:
!
!	FIL_LEN - length of file name
!	FIL_PTR - pointer to file name
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    LOCAL
	FIL: VECTOR[CH$ALLOCATION(EXTENDED_FILE_SPEC)],
	FIL_P,
	FIL_SIZ,
	STS;

    IF
	.CMD NEQ K_ANNOTATE_COM
    THEN
	BEGIN
	IF
	    .MERGE EQL NO_MRG
	THEN
	    BEGIN
	    FIL_P=.FIL_PTR;
	    FIL_SIZ=.FIL_LEN
	    END
	ELSE
	IF
	    .MERGE EQL MRG_MAIN
	THEN
	    BEGIN
	    FIL_P=CH$PTR(UPLIT(TM1));
	    FIL_SIZ=%CHARCOUNT(TM1)
	    END
	ELSE
	IF
	    .MERGE EQL MRG_BRNCH
	THEN
	    BEGIN
	    FIL_P=CH$PTR(UPLIT(TM2));
	    FIL_SIZ=%CHARCOUNT(TM2)
	    END
	ELSE
	    BUG(LIT('Illegal merge designator (RESFIL)'));

	IF
	    .SEQ_SEEN
	THEN
	    STS=$STEP_OPEN(IOB=OUTPUT_IOB,FILE_SPEC=(.FIL_SIZ,.FIL_P),
		OPTIONS=OUTPUT,ATTRIBUTES=SEQUENCED,FAILURE=0)
	ELSE
	    STS=$STEP_OPEN(IOB=OUTPUT_IOB,FILE_SPEC=(.FIL_SIZ,.FIL_P),
			    OPTIONS=OUTPUT,FAILURE=0);
	IF
	    NOT .STS
	THEN
	    BEGIN
	    ERSXPO(s_onoopen,.STS,CAT(('Cannot open output file '),
				(.FIL_SIZ,.FIL_P)));
	    BYE(s_useverrec,LIT(%string(' Use ',fac_name,' VERIFY/RECOVER')))
	    END;

	O_OPN=TRUE

	END

    END;				!End of SETOUT

ROUTINE TERMINATE : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Close the working files
!
! FORMAL PARAMETERS:
!
!	NONE.
!
! IMPLICIT INPUTS:
!
!	Input and output IOBs
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    IF
	.I_OPN
    THEN
	$step_close(IOB=INPUT_IOB);


    !The following conditionals are merely trying to close the output iob
    !only if a chronology is not wanted and this isn't a merge

    IF
    	.CHRONO AND
    	.CHRLEN NEQ 0 AND
    	.MERGE EQL NO_MRG
    THEN
    	RETURN ;


    IF  
        .O_OPN 
    	
    THEN
    	BEGIN
    
        IF
    	    VERNUM( OUTPUT_IOB[IOB$T_RESULTANT] ) GTR 1
        THEN
    	    BEGIN
	    LOCAL
		FIL_SPEC : DESC_BLOCK ,
		RES_SPEC : DESC_BLOCK ;
	    $STR_DESC_INIT( DESCRIPTOR = FIL_SPEC,
			    STRING = (.FIL_LEN, .FIL_PTR)) ;
	    $STR_DESC_INIT( DESCRIPTOR = RES_SPEC,
			    STRING = (.OUTPUT_IOB[IOB$H_RESULTANT],.OUTPUT_IOB[IOB$A_RESULTANT]));
	    IF NATEQL ( FIL_SPEC, RES_SPEC) 
	    THEN
		BEGIN
    	    	FETSTS = s_isthere;
            	sysmsg(s_isthere,CAT((.FIL_LEN, .FIL_PTR),
			%string(' already exists, so the next ',
				%if VaxVms %then 'version', %fi
				%if Tops20 %then 'file generation', %fi
				' has been created')),0) ;
    	    	END ;
	END;
    	$step_close(IOB = OUTPUT_IOB) ;
    	END ;


    END;				!End of TERMINATE

GLOBAL ROUTINE WRT_LINE (LENGTH,POINTER) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Write a text line, including any source audit if existing
!
! FORMAL PARAMETERS:
!
!	LENGTH - length of text line
!	POINTER - pointer to text line
!
! IMPLICIT INPUTS:
!
!	Input and output IOBs
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    !See if any pattern exists
    IF
	NOT .NOTES OR
	.NOTLEN EQL 0
    THEN
	!If no pattern, do it the simple way
	BEGIN
	OUTTXT(.POINTER,.LENGTH,TRUE);
	RETURN
	END;

    ! Don't place an audit mark on a line with just a form-feed

    if .length eql 1 and
       ch$rchar(.pointer) eql %o'14'
    then
	begin
	outtxt(.pointer, .length, true);
	return
	end;

    !Process left margin audit, if any
    IF
	.PATPOS EQL 0
    THEN
	BEGIN

	IF
	    .LGEN_L EQL 0
	THEN
	    !No generation expression, use fill only
	    BEGIN

	    LOCAL
		FILL_CNT;

	    FILL_CNT=.PAT_FIL;

	    UNTIL
		.FILL_CNT LEQ 0
	    DO
		BEGIN
		STG('	',FALSE);
		FILL_CNT=.FILL_CNT-8
		END
	    END
	ELSE
	    !Place the audit mark in the line
	    BEGIN

	    !Left part
	    IF
		.PAT_LLS NEQ 0
	    THEN
		OUTTXT(CH$PTR(PAT_LS),.PAT_LLS,FALSE);

	    IF
		.PAT_GEN
	    THEN
		BEGIN

		!Blank fill
		INCR I FROM 1 TO .PAT_FIL-.PAT_LLS-.PAT_LRS-.LGEN_L-1 DO
		    STG(' ',FALSE);

		!Output generation number proper
		OUTTXT(.LGEN,.LGEN_L,FALSE);

		!Right part
		IF
		    .PAT_LRS NEQ 0
		THEN
		    OUTTXT(CH$PTR(PAT_RS),.PAT_LRS,FALSE);

		STG(' ',FALSE)

		END
	    ELSE
		INCR I FROM 1 TO .PAT_FIL-.PAT_LLS DO
		    STG(' ',FALSE)

	    END

	END;

    !Output the line of text proper
    OUTTXT(.POINTER,.LENGTH,FALSE);

    !See if a trailing audit is required
    IF
	.PATPOS NEQ 0 AND
	.LGEN_L NEQ 0
    THEN
	BEGIN

	LOCAL
	    COL_POS;

	COL_POS=0;

	!Count the effective length of the line
	INCR I FROM 1 TO .LENGTH DO
	    BEGIN

	    LOCAL
		CHAR;

	    CHAR=CH$RCHAR(CH$PLUS(.POINTER,.I-1));

	    !Ignore non-printing characters
	    IF
		.CHAR GEQ %C' ' OR
		.CHAR EQL %C'	'
	    THEN
		BEGIN
		IF
		    .CHAR NEQ %C'	'
		THEN
		    COL_POS=.COL_POS+1
		ELSE
		    COL_POS=.COL_POS-(.COL_POS MOD 8)+8
		END;

	    END;

	IF
	    .COL_POS LSS .PATPOS - 1
	THEN
	    !Insert filler
	    BEGIN

	    !Fill to nearest tab
	    IF
		.COL_POS+8-(.COL_POS MOD 8) LEQ .PATPOS-1
	    THEN
		BEGIN
		STG('	',FALSE);
		COL_POS=.COL_POS+8-(.COL_POS MOD 8)
		END;

	    !Tab as close to end as possible
	    UNTIL
		.COL_POS+8 GTR .PATPOS-2
	    DO
		BEGIN
		STG('	',FALSE);
		COL_POS=.COL_POS+8
		END;

	    !Fill in the remainder
	    INCR I FROM .COL_POS+1 TO .PATPOS-1 DO
		STG(' ',FALSE);

	    END
	ELSE

    	! Special Case . If the line ends exactly where the position is
	! we must force a blank
	if 
	    .col_pos eql .patpos - 1
	then
	    stg(' ',false)
	else
	    !Line is very long, insert exactly one blank
	    STG(' ',FALSE);

	!Left part
	IF
	    .PAT_LLS NEQ 0
	THEN
	    OUTTXT(CH$PTR(PAT_LS),.PAT_LLS,FALSE);

	!Generation number
	IF
	    .PAT_GEN
	THEN
	    BEGIN
	    OUTTXT(.LGEN,.LGEN_L,FALSE);

	    !Blank fill
	    INCR I FROM 1 TO .MAX_G_LGT-.LGEN_L DO
		STG(' ',FALSE);
	    END;

	IF
	    .PAT_LRS NEQ 0
	THEN
	    !Right part
	    OUTTXT(CH$PTR(PAT_RS),.PAT_LRS,FALSE);


	END;

    !Not required, terminate the line
    OUTTXT(0,0,TRUE)

    END;				!End of WRT_LINE

END				!End of Module RESFIL
ELUDOM