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

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

!
!			  COPYRIGHT (C) 1982 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:
!
!	OUTSTG utility
!
! ENVIRONMENT:	VAX/VMS, DS-20
!
! AUTHOR: D. Knight , CREATION DATE: 16-Aug-79
!
!--

!
! TABLE OF CONTENTS
!

FORWARD ROUTINE
	OUTINI: NOVALUE,		!Initialize output
	OUTNUM: NOVALUE,		!Output decimal value
	OUTNMZ : NOVALUE,		!Output filled string
	OUTSTG;				!Output string

!
! INCLUDE FILES:
!

%if %bliss(bliss32)

%then library 'sys$library:starlet';

%else require 'jsys:';

%fi

LIBRARY 'XPORT:';			!XPORT I/O macros

REQUIRE 'SCONFG:';			!CMS configuration options

REQUIRE 'BLISSX:';

REQUIRE 'COMUSR:';

REQUIRE 'HOSUSR:';

!
! MACROS:
!

!
! EQUATED SYMBOLS:
!

LITERAL
	DEF_BUF_INC=300;		!Default buffer increment

!
! OWN STORAGE:
!
global

     calc_crc : initial(0),
     f_perf_crc ,		! Perform CRC calculation if true
     ignore_control : initial(false) ;

OWN
	LINE_BUF,			!Pointer to line buffer
	LINE_BUF_SIZE : INITIAL(0),	!Size of current line buffer
	LINEPTR,
	TXTIOB: INITIAL(0);

!
! EXTERNAL REFERENCES:
!

EXTERNAL ROUTINE
	BUG,
	CRCCALC,
	DECASC,
	DECASZ;

GLOBAL ROUTINE OUTINI (IOB) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!
!	NONE.
!
! IMPLICIT INPUTS:
!
!	NONE.
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    IF
	.LINE_BUF_SIZE NEQ 0
    THEN
	LINEPTR=.LINE_BUF;

    TXTIOB=.IOB

    END;				!End of OUTINI

GLOBAL ROUTINE OUTNUM (VALUE,TERM) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Output a specified value as an ASCII string.
!
! FORMAL PARAMETERS:
!
!	VALUE - value to be converted to ASCII
!	TERM - true if end of line, false if not.
!
! IMPLICIT INPUTS:
!
!	NONE.
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    LOCAL
	TEXT : VECTOR[CH$ALLOCATION(MAX_NUM_SIZE)],
	TEXT_SIZ;

    !Convert the number
    TEXT_SIZ=DECASC(.VALUE,CH$PTR(TEXT));

    !Output the value
    OUTSTG(CH$PTR(TEXT),.TEXT_SIZ,.TERM)

    END;				!End of OUTNUM

GLOBAL ROUTINE OUTNMZ (VALUE,FIELD_SZ,TERM) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Output a specified value as a zero filled ASCII string.
!
! FORMAL PARAMETERS:
!
!	VALUE - value to be converted to ASCII
!	TERM - true if end of line, false if not.
!
! IMPLICIT INPUTS:
!
!	NONE.
!
! IMPLICIT OUTPUTS:
!
!	NONE.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    LOCAL
	TEXT : VECTOR[CH$ALLOCATION(MAX_NUM_SIZE)],
	TEXT_SIZ;

    !Convert the number
    TEXT_SIZ=DECASZ(.VALUE,CH$PTR(TEXT),.FIELD_SZ);

    !Output the value
    OUTSTG(CH$PTR(TEXT),.TEXT_SIZ,.TERM)

    END;				!End of OUTNUM

GLOBAL ROUTINE OUTSTG (PTR,LGT,TERM) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Put a string into the output buffer and output it if desired.
!
! FORMAL PARAMETERS:
!
!	PTR - Pointer to string
!	LGT - length of string
!	TERM - if true, output the complete line
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	Length of line output
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    BEGIN

    LOCAL
	crc,
	CNT;

    CNT=0;

    !Move text into buffer if there is any
    IF
	.PTR NEQ 0 AND
	.LGT GTR 0
    THEN
	BEGIN

	!See if room exists
	IF
	    CH$DIFF(.LINEPTR,.LINE_BUF)+.LGT GTR .LINE_BUF_SIZE
	THEN
	    !Get a new buffer which is large enough to continue
	    BEGIN

	    LOCAL
		T_BUF,
		T_PTR;

	    !Allocate new storage for output buffer
	    IF
		.LINE_BUF_SIZE GTR 3000
	    THEN
		BUG(LIT('Text buffer overflow in OUTSTG'));

	    $XPO_GET_MEM(CHARACTERS=.LINE_BUF_SIZE+DEF_BUF_INC,RESULT=T_BUF);
	    T_PTR=.T_BUF;

	    !Transfer the existing text to the new larger buffer
	    IF
		.LINE_BUF_SIZE NEQ 0
	    THEN
		BEGIN
		T_PTR=CH$MOVE(CH$DIFF(.LINEPTR,.LINE_BUF),.LINE_BUF,.T_PTR);

		!Return old buffer to free storage
		$XPO_FREE_MEM(STRING=(.LINE_BUF_SIZE,.LINE_BUF))
		END;

	    !Set pointers to user buffer and set new buffer size
	    LINEPTR=.T_PTR;
	    LINE_BUF=.T_BUF;
	    LINE_BUF_SIZE=.LINE_BUF_SIZE+DEF_BUF_INC
	    END;

	LINEPTR=CH$MOVE(.LGT,.PTR,.LINEPTR)

	END;

    !See if line is to be terminated and output
    IF
	.TERM
    THEN
	BEGIN

	!See how many characters there are
	CNT=CH$DIFF(.LINEPTR,.LINE_BUF);

	IF
	    .TXTIOB EQL 0
	THEN
	    BUG(LIT('Uninitialized text buffer'));

	!Determine CRC if flag is on
	if .f_perf_crc 
	then
	    begin
	    if ch$eql(4,ch$ptr(uplit('*/C:')),4,.line_buf)
	    then
		begin	! We've found the last replacements CRC string
		if not .ignore_control
		then
		    f_perf_crc = false;
		lineptr = .line_buf;
		return .cnt
		end
	    else
		begin
	    	crc = crccalc(.cnt, .line_buf) ;
	    	calc_crc = .crc + .calc_crc;
	    	end;
	    end;

	!Output the entire line
	$step_put(IOB=.TXTIOB,STRING=(.CNT,.LINE_BUF));
	!Now reset the buffer pointer
	LINEPTR=.LINE_BUF

	END;

    .CNT

    END;				!End of OUTSTG

END					!End of Module TXTIO
ELUDOM