Google
 

Trailing-Edge - PDP-10 Archives - BB-KL11L-BM_1990 - t20src/mxntxt.b36
There are 13 other files named mxntxt.b36 in the archive. Click here to see a list.
module NMUTXT (					! Text formatting
		ident = 'X04.08'
		) =
begin
!	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1985, 1989.
!	ALL RIGHTS RESERVED.
!
!	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 THAT IS NOT SUPPLIED BY DIGITAL.
!++
! Facility: LSG DECnet Network Management
!
! Abstract: This module provides text formatting facilities.  The main
!           global routine (NMU$TEXT) is called with a text pattern, a
!           set of parameter values and a output pointer.  The pattern
!           is interpreted (copying or processing directives) to generate
!           the output string.
!
! Environment: TOPS10/TOPS20 user mode, MCB RSX task level
!
! Author: Steven M. Jenness, Creation date: 10-Oct-80
!
!--

!<BLF/SYNONYM %unquote =>
!<BLF/PAGE>
!
! Include files
!

library 'MXNLIB';			! All required definitions

%if $TOPS20
    %then
	library 'MONSYM';			! Monitor symbols

	library 'MXJLNK';			! JSYS linkage definitions
    %fi

!
! Global routines
!

forward routine
    NMU$TEXT_MANAGER;				! Define entry points

!
! Local routines
!

forward routine
    TEXT_R,					! Recursive pattern interpreter
    NEXT_PARM,					! Get next parameter value
    CHAR_OUT,					! Send character to output stream
    REPEAT : novalue,				! Repeat directive
    PROCESS_DIRECTIVE : novalue,		! Directive processing routine
    JUSTIFICATION : novalue,			! Field justification/fill
    $C5TA : novalue,				! RAD50 to ASCII string
    CVTC,					! Extract RAD50 character
    NUMBER_CONVERSION : novalue,		! General binary to ASCII
    $CBDAT : novalue,				! Binary to 2 digit DECIMAL
    DATE_CONVERSION : novalue,			! Date
    TIME_CONVERSION : novalue;			! Time

!
! Character codes
!

literal
    SPACE = %C' ',
    TAB = %C'	',
    FORM_FEED = %O'14',
    CARRIAGE_RETURN = %O'15',
    LINE_FEED = %O'12',
    NULL = %O'0';

!
! Own variables
!

own
    TSB_SPACE : TEXT_STATE_BLOCK;

!
! External routines
!

external routine
	NMU$MEMORY_MANAGER;		! Memory management routines
global routine %unquote NMU$TEXT (OUTPUT, OUTPUT_LIMIT, PATTERN, PARM_COUNT, PARM_LIST) =

!++
! Functional description:
!
!
! Formal parameters:
!
!       .OUTPUT          Address of byte pointer to output stream.
!       .OUTPUT_LIMIT    Max characters to output.
!       .PATTERN         Byte pointer to directive pattern.
!       .PARM_COUNT      Number of parameters in parameter list.
!       .PARM_LIST       Address of parameter list.
!
! Routine value:
!
!       The number of characters sent to the output stream.
!	If the interpretation/conversion failed, the character
!	count is the negated.
!
! Side effects:
!
!       The output byte pointer is updated to point to the
!       end of the output stream.
!
!--

    begin

    local
	TSB : ref TEXT_STATE_BLOCK,
	RESULT;

!
! Allocate a text state block
!
    TSB = TSB_SPACE;

!
!  Changed back to statically allocated TSB since the TRACE_INFO
!  macro used the NMU$TEXT routine to format it's output.  This
!  created a recursive loop when tracing was done in the memory
!  manager.
!
!   TSB = NMU$MEMORY_GET (TEXT_BLOCK_ALLOCATION);
!

!
! Initialize state block from calling parameters
!
    TSB [PARAMETER_LIST] = .PARM_LIST;
    TSB [PARAMETER_NEXT] = .PARM_LIST;
    TSB [PARAMETER_COUNT] = .PARM_COUNT;
!
    TSB [PATTERN_START] = .PATTERN;
    TSB [PATTERN_PTR] = .PATTERN;
    TSB [PATTERN_CHECKPOINT] = .PATTERN;
!
    TSB [OUTPUT_ROUTINE] = CHAR_OUT;
    TSB [OUTPUT_START] = ..OUTPUT;
    TSB [OUTPUT_PTR] = ..OUTPUT;
    TSB [OUTPUT_MAX] = .OUTPUT_LIMIT;
    TSB [OUTPUT_COUNT] = 0;
    TSB [OUTPUT_POSITION] = 0;
!
    TSB [NULL_SUPPRESS] = $false;
!
! Call recursive interpreter
!
    TEXT_R (.TSB);
!
! If a null is wanted at the end .. make the output string
! ASCIZ
!

    if (.TSB [STATE] eql DONE) and ( not .TSB [NULL_SUPPRESS]) then CHAR_OUT (.TSB, 0);
!
! Return the final output pointer
!
    .OUTPUT = .TSB [OUTPUT_PTR];
!
! Set the resulting count of output characters
! depending on the terminating state of the
! interpreter.
!
    if .TSB [STATE] eql DONE
    then RESULT = .TSB [OUTPUT_COUNT]
    else RESULT = -.TSB [OUTPUT_COUNT];
!
! Release the text state block.
!
!    NMU$MEMORY_RELEASE (.TSB, TEXT_BLOCK_ALLOCATION);
!
! Return resulting count of output characters
!
    .RESULT

    end;					! End of NMU$TEXT
routine TEXT_R (TSB) =

!++
! Functional description:
!
!
! Formal parameters:
!
!       TSB     Address of a text state block (see field definition
!               above).
!
! Routine value:
!
!       $TRUE    Interpretation has been successful.
!       $FALSE   An error has been detected and interpretation aborted.
!
! Side effects: none
!
!--

    begin

    map
	TSB : ref TEXT_STATE_BLOCK;

    local
	CHAR;

    TSB [STATE] = TEXT_COPY;

    while (.TSB [STATE] lss DONE) do

	if (CHAR = ch$rchar_a (TSB [PATTERN_PTR])) eql 0
	then

	    if .TSB [STATE] eql TEXT_COPY then TSB [STATE] = DONE else TSB [STATE] = ABORT

	else

	    case .TSB [STATE] from STATE_MIN to STATE_MAX of
		set

		[TEXT_COPY] :

		    if .CHAR eql %C'%'
		    then
			begin
			TSB [STATE] = DIRECTIVE_START;
			TSB [PATTERN_CHECKPOINT] = ch$plus (.TSB [PATTERN_PTR], -1);
			end
		    else
			CHAR_OUT (.TSB, .CHAR);

		[DIRECTIVE_START] :
		    begin
		    TSB [FIELD_DEFAULT] = $true;
		    TSB [FIELD_NOWIDTH] = $true;
		    TSB [FIELD_REPEAT] = 1;
		    TSB [FIELD_WIDTH] = .TSB [OUTPUT_MAX] - .TSB [OUTPUT_COUNT];
		    TSB [FIELD_COUNT] = 0;
		    TSB [FIELD_JUSTIFY] = NO_FILL;

		    selectone .CHAR of
			set

			[%C'#'] :
			    begin
			    TSB [FIELD_DEFAULT] = $false;
			    TSB [STATE] = REPT_PARM;
			    TSB [FIELD_REPEAT] = NEXT_PARM (.TSB);
			    end;

			[%C'('] :
			    TSB [STATE] = WIDTH_START;

			[%C'0' to %C'9'] :
			    begin
			    TSB [FIELD_REPEAT] = .CHAR - %C'0';
			    TSB [FIELD_DEFAULT] = $false;
			    TSB [STATE] = REPT_VALUE;
			    end;

			[otherwise] :
			    PROCESS_DIRECTIVE (.TSB, .CHAR);
			tes;

		    end;

		[REPT_PARM] :

		    if .CHAR eql %C'(' then TSB [STATE] = WIDTH_START else PROCESS_DIRECTIVE (.TSB, .CHAR);

		[REPT_VALUE] :

		    if .CHAR eql %C'('
		    then
			TSB [STATE] = WIDTH_START
		    else

			if ((.CHAR lss %C'0') or (.CHAR gtr %C'9'))
			then
			    PROCESS_DIRECTIVE (.TSB, .CHAR)
			else
			    TSB [FIELD_REPEAT] = (.TSB [FIELD_REPEAT]*10) + .CHAR - %C'0';

		[WIDTH_START] :

		    selectone .CHAR of
			set

			[%C'#'] :
			    begin
			    TSB [STATE] = WIDTH_PARM;
			    TSB [FIELD_WIDTH] = NEXT_PARM (.TSB);
			    TSB [FIELD_NOWIDTH] = $false;
			    end;

			[%C'0' to %C'9'] :
			    begin
			    TSB [FIELD_WIDTH] = .CHAR - %C'0';
			    TSB [STATE] = WIDTH_VALUE;
			    TSB [FIELD_NOWIDTH] = $false;
			    end;

			[otherwise] :
			    TSB [STATE] = ABORT;
			tes;

		[WIDTH_PARM] :

		    selectone .CHAR of
			set

			[%C')'] :
			    TSB [STATE] = WIDTH_END;

			[%C'L'] :
			    begin
			    TSB [STATE] = JUSTIFY_FIELD;
			    TSB [FIELD_JUSTIFY] = LEFT_JUSTIFY;
			    end;

			[%C'R'] :
			    begin
			    TSB [STATE] = JUSTIFY_FIELD;
			    TSB [FIELD_JUSTIFY] = RIGHT_JUSTIFY;
			    end;

			[%C'C'] :
			    begin
			    TSB [STATE] = JUSTIFY_FIELD;
			    TSB [FIELD_JUSTIFY] = CENTER_FILL;
			    end;

			[otherwise] :
			    TSB [STATE] = ABORT;
			tes;

		[WIDTH_VALUE] :

		    selectone .CHAR of
			set

			[%C')'] :
			    TSB [STATE] = WIDTH_END;

			[%C'L'] :
			    begin
			    TSB [STATE] = JUSTIFY_FIELD;
			    TSB [FIELD_JUSTIFY] = LEFT_JUSTIFY;
			    end;

			[%C'R'] :
			    begin
			    TSB [STATE] = JUSTIFY_FIELD;
			    TSB [FIELD_JUSTIFY] = RIGHT_JUSTIFY;
			    end;

			[%C'C'] :
			    begin
			    TSB [STATE] = JUSTIFY_FIELD;
			    TSB [FIELD_JUSTIFY] = CENTER_FILL;
			    end;

			[%C'0' to %C'9'] :
			    TSB [FIELD_WIDTH] = (.TSB [FIELD_WIDTH]*10) + .CHAR - %C'0';

			[otherwise] :
			    TSB [STATE] = ABORT;
			tes;

		[JUSTIFY_FIELD] :

		    if .CHAR eql %C')' then TSB [STATE] = WIDTH_END else TSB [STATE] = ABORT;

		[WIDTH_END] :
		    PROCESS_DIRECTIVE (.TSB, .CHAR);
		tes;

    if .TSB [STATE] eql DONE then $true else $false

    end;					! End of TEXT_R
routine CHAR_OUT (TSB, CHAR) =

!++
! Functional description:
!
!	Writes a character into the output stream if there is still
!	room in the output buffer. If output overflow would occur with
!	this call the output is not done and the output count is not
!	updated.
!	
!
! Formal parameters: none
!
!       TSB      Text state block.
!       CHAR     Character to output.
!
! Routine value:
!
!       $TRUE     if character was successfully output.
!       $FALSE    if output overflow occured.
!
! Side effects:
!
!	If a character was written into the output buffer the
!	OUTPUT_COUNT field of the TSB is incremented.
!       If the total output buffer overflowed, the state
!       is changed to BUFFER_OVERFLOW.
!
!--

    begin

    map
	TSB : ref TEXT_STATE_BLOCK;
!
! Check if character should really be output.
! Check all overflows: buffer and field.
!
    if .TSB [STATE] leq DONE
    then
	begin

	if .TSB [OUTPUT_COUNT] geq .TSB [OUTPUT_MAX]
	then
	    begin
	    TSB [STATE] = BUFFER_OVERFLOW;
	    return $false;
	    end
	else

	    if (.TSB [STATE] neq TEXT_COPY) and (.TSB [STATE] lss DONE)
	    then
		begin
		TSB [FIELD_COUNT] = .TSB [FIELD_COUNT] + 1;

		if .TSB [FIELD_COUNT] gtr .TSB [FIELD_WIDTH]
		then
		    begin
		    TSB [FIELD_OVERFLOW] = $true;
		    return $false;
		    end;

		end;
!
! Adjust horizontal position value
!
	if .CHAR geq SPACE
	then TSB [OUTPUT_POSITION] = .TSB [OUTPUT_POSITION] + 1
	else
	    if .CHAR eql CARRIAGE_RETURN
	    then TSB [OUTPUT_POSITION] = 0;
!
! Write character to output buffer
!
	TSB [OUTPUT_COUNT] = .TSB [OUTPUT_COUNT] + 1;
	ch$wchar_a (.CHAR, TSB [OUTPUT_PTR]);
	$true
	end
    else
	$false

    end;					! End of CHAR_OUT
routine NEXT_PARM (TSB) =

!++
! Functional description:
!
!
! Formal parameters:
!
!       TSB     Text state block (see format above).
!
! Routine value:
!
!       Next value in parameter list (if any).
!
! Side effects:
!
!       The state is changed to ABORT if the parameter list
!       is overflowed.
!
!--

    begin

    map
	TSB : ref TEXT_STATE_BLOCK;

    bind
	PARM_LIST = .TSB [PARAMETER_NEXT] : vector;

    if .TSB [PARAMETER_COUNT] leq 0
    then
	TSB [STATE] = ABORT
    else
	begin
	TSB [PARAMETER_COUNT] = .TSB [PARAMETER_COUNT] - 1;
	TSB [PARAMETER_NEXT] = PARM_LIST [1];
	.PARM_LIST [0]
	end

    end;					! End of NEXT_PARM
routine PROCESS_DIRECTIVE (TSB, CHAR) : novalue =

!++
! Functional description:
!
!
! Formal parameters:
!
!       .TSB    Text state block address
!       .CHAR   Directive character
!
! Routine value: none
! Side effects:
!
!       The state may be changed to ABORT if a failure
!       during directive processing occurs.
!
!--

    begin

    map
	TSB : ref TEXT_STATE_BLOCK;

    TSB [FIELD_SIGNED] = $false;
    TSB [FIELD_ZERO_SUPPRESS] = $true;
    TSB [FIELD_OVERFLOW] = $false;
    TSB [OUTPUT_CHECKPOINT] = .TSB [OUTPUT_COUNT];

    selectone .CHAR of
	set
!
! Insert a '%' into the output stream
!

	[%C'%'] :
	    begin

	    bind
		REPT = TSB [FIELD_REPEAT];

	    while (REPT = .REPT - 1) geq 0 do
		CHAR_OUT (.TSB, %C'%');

	    end;
!
! Bypass some parameters
!

	[%C'+'] :
	    begin

	    bind
		REPT = TSB [FIELD_REPEAT],
		PARM_LIST = .TSB [PARAMETER_NEXT] : vector;

	    if (PARM_LIST [.REPT] lss .TSB [PARAMETER_LIST]) or (.TSB [PARAMETER_COUNT] - .REPT) leq 0
	    then
		TSB [STATE] = ABORT
	    else
		begin
		TSB [PARAMETER_NEXT] = PARM_LIST [.REPT];
		TSB [PARAMETER_COUNT] = .TSB [PARAMETER_COUNT] - .REPT;
		end;

	    end;
!
! Back up over some parameters
!

	[%C'-'] :
	    begin

	    bind
		REPT = TSB [FIELD_REPEAT];

	    bind
		PARM_LIST = .TSB [PARAMETER_NEXT] : vector;

	    if (PARM_LIST [-.REPT] lss .TSB [PARAMETER_LIST]) or (.TSB [PARAMETER_COUNT] + .REPT) leq 0
	    then
		TSB [STATE] = ABORT
	    else
		begin
		TSB [PARAMETER_NEXT] = PARM_LIST [-.REPT];
		TSB [PARAMETER_COUNT] = .TSB [PARAMETER_COUNT] + .REPT;
		end;

	    end;
!
! Insert one or more CR/LF pairs
!

	[%C'/'] :
	    begin

	    bind
		REPT = TSB [FIELD_REPEAT];

	    while (REPT = .REPT - 1) geq 0 do
		begin
		CHAR_OUT (.TSB, CARRIAGE_RETURN);
		CHAR_OUT (.TSB, LINE_FEED)
		end;

	    end;
!
! Transfer character string to output stream.
!

	[%C'A'] :
	    begin

	    bind
		REPT = TSB [FIELD_REPEAT];

	    local
		CHAR,
		PTR;

	    PTR = NEXT_PARM (.TSB);

	    if .TSB [FIELD_DEFAULT]
	    then
		while (CHAR = ch$rchar_a (PTR)) neq 0 do
		    CHAR_OUT (.TSB, .CHAR)
	    else
		while (REPT = .REPT - 1) geq 0 do
		    CHAR_OUT (.TSB, ch$rchar_a (PTR));

	    end;
!
! Display character item as unsigned octal number.
!
! If the rept count is less than zzero then a pointer
! to the character stream to use as a separator.
!   
! Next parameter item is a pointer to characters for
! conversion.
!

	[%C'B'] :
	    begin

	    bind
		REPT = TSB [FIELD_REPEAT];

	    local
		PTR,
		COUNT_SAVE,
		WIDTH_SAVE,
		SEP_PTR;

	    if (.REPT lss 0)
	    then
		begin
		SEP_PTR = NEXT_PARM (.TSB);
		REPT = -.REPT;
		end
	    else
		SEP_PTR = ch$asciz (' ');

	    PTR = NEXT_PARM (.TSB);

	    if (.TSB [STATE] lss DONE) and (.REPT gtr 0)
	    then
		begin
		WIDTH_SAVE = .TSB [FIELD_WIDTH];
		TSB [FIELD_RADIX] = 8;
		TSB [FIELD_ZERO_SUPPRESS] = $false;

		while (REPT = .REPT - 1) geq 0 do
		    begin
		    TSB [FIELD_WIDTH] = 3;
		    COUNT_SAVE = .TSB [FIELD_COUNT];
		    TSB [FIELD_COUNT] = 0;
		    NUMBER_CONVERSION (.TSB, ch$rchar_a (PTR));
		    TSB [FIELD_WIDTH] = .WIDTH_SAVE;
		    TSB [FIELD_COUNT] = .COUNT_SAVE + 3;

		    if .REPT gtr 0
		    then
			begin
			local NPTR, CHAR;
			NPTR = .SEP_PTR;
			while (CHAR = ch$rchar_a (NPTR)) neq 0
			do CHAR_OUT (.TSB, .CHAR);
			end
		    end;

		end;

	    end;
!
! Output character represented by integer value
!
	[%C'C'] :
	    begin

	    bind
		REPT = TSB [FIELD_REPEAT];

	    CHAR = NEXT_PARM (.TSB);

	    while (REPT = .REPT - 1) geq 0
	    do
		CHAR_OUT (.TSB, .CHAR);
	    end;
!
! Display parameter as signed decimal.
!

	[%C'D'] :
	    begin
	    TSB [FIELD_SIGNED] = $true;
	    TSB [FIELD_RADIX] = 10;
	    REPEAT (.TSB);
	    end;
!
! Insert character string while editing undisplayable
! characters to the character '.'.
!

	[%C'E'] :
	    begin

	    bind
		REPT = TSB [FIELD_REPEAT];

	    local
		CHAR,
		PTR;

	    PTR = NEXT_PARM (.TSB);

	    while (REPT = .REPT - 1) geq 0 do
		begin
		CHAR = ch$rchar_a (PTR);

		if .CHAR lss SPACE or .CHAR gtr 125 then CHAR = %C'.';

		CHAR_OUT (.TSB, .CHAR)
		end;

	    end;
!
! Display parameter as unsigned Hexadecimal (zero suppressed).
!

	[%C'H'] :
	    begin
	    TSB [FIELD_RADIX] = 16;
	    REPEAT (.TSB);
	    end;
!
! Recurse to interpret a indirect pattern
!

	[%C'I'] :
	    begin

	    local
		SAVE_P_STATE,
		SAVE_P_PTR,
		SAVE_P_START,
		SAVE_P_CHKPNT;

	    SAVE_P_PTR = .TSB [PATTERN_PTR];
	    SAVE_P_START = .TSB [PATTERN_START];
	    SAVE_P_CHKPNT = .TSB [PATTERN_CHECKPOINT];
	    SAVE_P_STATE = .TSB [STATE];
	    TSB [PATTERN_START] = NEXT_PARM (.TSB);

	    if .TSB [STATE] neq ABORT
	    then
		begin
		TSB [PATTERN_PTR] = .TSB [PATTERN_START];
		TSB [PATTERN_CHECKPOINT] = .TSB [PATTERN_START];
		TEXT_R (.TSB);
		TSB [PATTERN_PTR] = .SAVE_P_PTR;
		TSB [PATTERN_CHECKPOINT] = .SAVE_P_CHKPNT;
		if .TSB [STATE] neq ABORT
		THEN
		    TSB [STATE] = .SAVE_P_STATE;
		end;

	    TSB [PATTERN_START] = .SAVE_P_START;
	    end;
!
! Interpret TOPS20 specific error code.
!

        [%C'J'] :

           %if $TOPS20
           %then

                begin

                DECLARE_JSYS (ERSTR)

                local
                     CODE,
                     COUNT,
                     RETPTR;

                CODE <0, 18>  = NEXT_PARM (.TSB);
                CODE <18, 18> = $FHSLF;
                COUNT <0, 18>  = 0;
                COUNT <18, 18> = .TSB [FIELD_WIDTH];
	
                case $$ERSTR (.TSB [OUTPUT_PTR], .CODE, .COUNT; RETPTR)
                     from 0 to 2 of
                     set
                     [0] : 0;    ! Undefined error number
                     [1] : TSB [FIELD_OVERFLOW] = $true;
                     [2] :
                         begin
                         local CPYCNT;
                         CPYCNT = ch$diff (.RETPTR, .TSB [OUTPUT_PTR]);
                         TSB [OUTPUT_COUNT] = .TSB [OUTPUT_COUNT] + .CPYCNT;
                         TSB [OUTPUT_POSITION] = .TSB [OUTPUT_POSITION] + .CPYCNT;
                         TSB [OUTPUT_PTR] = .RETPTR;
                         end;
                     tes;
                end;

           %else
                0;
           %fi
!
! Display character item as unsigned HEXADECIMAL number.
!
! If the rept count is less than zero then a pointer
! to the character stream to use as a separator.
!   
! Next parameter item is a pointer to characters for
! conversion.
!

	[%C'K'] :
	    begin

	    bind
		REPT = TSB [FIELD_REPEAT];

	    local
		PTR,
		COUNT_SAVE,
		WIDTH_SAVE,
		SEP_PTR;

	    if (.REPT lss 0)
	    then
		begin
		SEP_PTR = NEXT_PARM (.TSB);
		REPT = -.REPT;
		end
	    else
		SEP_PTR = ch$asciz (' ');

	    PTR = NEXT_PARM (.TSB);

	    if (.TSB [STATE] lss DONE) and (.REPT gtr 0)
	    then
		begin
		WIDTH_SAVE = .TSB [FIELD_WIDTH];
		TSB [FIELD_RADIX] = 16;
		TSB [FIELD_ZERO_SUPPRESS] = $false;

		while (REPT = .REPT - 1) geq 0 do
		    begin
		    TSB [FIELD_WIDTH] = 2;
		    COUNT_SAVE = .TSB [FIELD_COUNT];
		    TSB [FIELD_COUNT] = 0;
		    NUMBER_CONVERSION (.TSB, ch$rchar_a (PTR));
		    TSB [FIELD_WIDTH] = .WIDTH_SAVE;
		    TSB [FIELD_COUNT] = .COUNT_SAVE + 2;

		    if .REPT gtr 0
		    then
			begin
			local NPTR, CHAR;
			NPTR = .SEP_PTR;
			while (CHAR = ch$rchar_a (NPTR)) neq 0
			do CHAR_OUT (.TSB, .CHAR);
			end
		    end;

		end;

	    end;
!
! Display parameter as unsigned decimal (this assumes
! that the value is positive only).
!

	[%C'M'] :
	    begin
	    TSB [FIELD_RADIX] = 10;
	    REPEAT (.TSB);
	    end;
!
! Set suppress null at end of output flag
!

	[%C'N'] :
	    TSB [NULL_SUPPRESS] = $true;
!
! Display parameter as signed octal.
!

	[%C'O'] :
	    begin
	    TSB [FIELD_RADIX] = 8;
	    TSB [FIELD_SIGNED] = $true;
	    REPEAT (.TSB);
	    end;
!
! Display parameter as unsigned octal (this assumes that the
! value is positive only).
!

	[%C'P'] :
	    begin
	    TSB [FIELD_ZERO_SUPPRESS] = $false;
	    TSB [FIELD_RADIX] = 8;
	    REPEAT (.TSB);
	    end;
!
! Translate parameter from RAD50 format to ASCII.
!

	[%C'R'] :
	    begin

	    bind
		REPT = TSB [FIELD_REPEAT];

	    while (REPT = .REPT - 1) geq 0 do
		$C5TA (.TSB, NEXT_PARM (.TSB));

	    end;
!
! Insert one or more spaces.
!

	[%C'S'] :
	    begin

	    bind
		REPT = TSB [FIELD_REPEAT];

	    while (REPT = .REPT - 1) geq 0 do
		CHAR_OUT (.TSB, %C' ');

	    end;
!
! Tab to specified column.
!

	[%C'T'] :
	    begin

	    bind
		COLUMN = TSB [FIELD_REPEAT],
		POSITION = TSB [OUTPUT_POSITION];

	    if not .TSB [FIELD_NOWIDTH]
	    then POSITION = .TSB [FIELD_WIDTH] + .POSITION;

	    while ((.POSITION lss .COLUMN) and (.TSB [STATE] lss DONE))
	    do
		CHAR_OUT (.TSB, SPACE);
	    end;

!
! Display next parameter as unsigned decimal.
! no zero suppression is done.
!

	[%C'U'] :
	    begin
	    TSB [FIELD_RADIX] = 10;
	    TSB [FIELD_ZERO_SUPPRESS] = $false;
	    REPEAT (.TSB);
	    end;
!
! Insert character string while quoting undisplayable
! characters by the character '^V'.
!

	[%C'V'] :
	    begin

	    bind
		REPT = TSB [FIELD_REPEAT];

	    local
		CHAR,
		PTR;

	    PTR = NEXT_PARM (.TSB);

	    while (REPT = .REPT - 1) geq 0 do
		begin
		CHAR = ch$rchar_a (PTR);

		if ((.CHAR lss %c'A') or (.CHAR gtr %c'Z')) and
		   ((.CHAR lss %c'0') or (.CHAR gtr %c'9')) and
		   (.CHAR neq %c'-')
		then CHAR_OUT (.TSB, 22);

		CHAR_OUT (.TSB, .CHAR)
		end;

	    end;
!
! Counted string output.
!

	[%C'X'] :
	    begin

	    local
		PTR,
		COUNT;

	    PTR = NEXT_PARM (.TSB);
	    COUNT = ch$rchar_a (PTR);

	    while (COUNT = .COUNT - 1) geq 0
            do CHAR_OUT (.TSB, ch$rchar_a (PTR));

	    end;

!
! Date conversion.
!

	[%C'Y'] :
	    DATE_CONVERSION (.TSB, NEXT_PARM (.TSB));
!
! Time conversion.
!

	[%C'Z'] :
	    TIME_CONVERSION (.TSB, NEXT_PARM (.TSB), .TSB [FIELD_REPEAT]);
!
! Call user supplied routine.
!

	[%C'@'] :
	    BEGIN

	    bind routine
		USER_ROUTINE = NEXT_PARM (.TSB);

	    USER_ROUTINE (.TSB);
	    end;
!
! Insert one or more form-feeds.
!

	[%C'^'] :
	    begin

	    bind
		REPT = TSB [FIELD_REPEAT];

	    while (REPT = .REPT - 1) geq 0 do
		CHAR_OUT (.TSB, FORM_FEED);

	    end;
!
! Invalid character - abort processing
!

	[otherwise] :
	    TSB [STATE] = ABORT;
	tes;

    JUSTIFICATION (.TSB);

    if .TSB [STATE] lss DONE then TSB [STATE] = TEXT_COPY;

    end;					! End of PROCESS_DIRECTIVE
routine JUSTIFICATION (TSB) : novalue =

!++
! Functional description:
!
!
! Formal parameters:
!
!	TSB	Address of text state block
!
! Routine value: none
! Side effects: none
!
!--

    begin

    map
	TSB : ref TEXT_STATE_BLOCK;

    if .TSB [STATE] lss DONE
    then

	if .TSB [FIELD_OVERFLOW]
	then
	    begin

	    local
		PTR;

	    TSB [OUTPUT_PTR] = ch$plus (.TSB [OUTPUT_START], .TSB [OUTPUT_CHECKPOINT]);
	    TSB [STATE] = TEXT_COPY;

	    incr INDEX from 1 to .TSB [FIELD_WIDTH] do
		CHAR_OUT (.TSB, SPACE);

	    end
	else

	    if .TSB [FIELD_WIDTH] gtr .TSB [FIELD_COUNT]
	    then

		case .TSB [FIELD_JUSTIFY] from NO_FILL to CENTER_FILL of
		    set

		    [NO_FILL] :
			1;

		    [LEFT_JUSTIFY] :

			while .TSB [FIELD_COUNT] lss .TSB [FIELD_WIDTH] do
			    CHAR_OUT (.TSB, SPACE);

		    [RIGHT_JUSTIFY] :

			if (.TSB [OUTPUT_CHECKPOINT] + .TSB [FIELD_WIDTH]) gtr .TSB [OUTPUT_MAX]
			then
			    TSB [STATE] = BUFFER_OVERFLOW
			else
			    begin

			    local
				DST_PTR,
				SRC_PTR,
				CHAR;

			    DST_PTR = ch$plus (.TSB [OUTPUT_START],
				.TSB [OUTPUT_CHECKPOINT] + .TSB [FIELD_WIDTH]);
			    SRC_PTR = .TSB [OUTPUT_PTR];

			    incr INDEX from 1 to .TSB [FIELD_COUNT] do
				begin
				CHAR = ch$rchar (SRC_PTR = ch$plus (.SRC_PTR, -1));
				ch$wchar (.CHAR, (DST_PTR = ch$plus (.DST_PTR, -1)));
				end;

			    DST_PTR = ch$plus (.TSB [OUTPUT_START], .TSB [OUTPUT_CHECKPOINT]);

			    incr INDEX from .TSB [FIELD_COUNT] to .TSB [FIELD_WIDTH] - 1 do
				ch$wchar_a (SPACE, DST_PTR);

			    TSB [OUTPUT_PTR] = ch$plus (.TSB [OUTPUT_START],
				.TSB [FIELD_WIDTH] + .TSB [OUTPUT_CHECKPOINT]);
			    TSB [OUTPUT_COUNT] = .TSB [OUTPUT_CHECKPOINT] + .TSB [FIELD_WIDTH];
			    end;

		    [CENTER_FILL] :
			begin

			local
			    LEFT_FILL,
			    RIGHT_FILL,
			    DST_PTR,
			    SRC_PTR,
			    CHAR;

			LEFT_FILL = (.TSB [FIELD_WIDTH] - .TSB [FIELD_COUNT])/2;
			RIGHT_FILL = .TSB [FIELD_WIDTH] - .TSB [FIELD_COUNT] - .LEFT_FILL;
			DST_PTR = ch$plus (.TSB [OUTPUT_START],
			    .TSB [OUTPUT_CHECKPOINT] + .TSB [FIELD_COUNT] + .LEFT_FILL);
			SRC_PTR = .TSB [OUTPUT_PTR];

			incr INDEX from 1 to .TSB [FIELD_COUNT] do
			    begin
			    CHAR = ch$rchar (SRC_PTR = ch$plus (.SRC_PTR, -1));
			    ch$wchar (.CHAR, (DST_PTR = ch$plus (.DST_PTR, -1)));
			    end;

			DST_PTR = ch$plus (.TSB [OUTPUT_START], .TSB [OUTPUT_CHECKPOINT]);

			incr INDEX from 1 to .LEFT_FILL do
			    ch$wchar_a (SPACE, DST_PTR);

			DST_PTR = ch$plus (.TSB [OUTPUT_START],
			    .TSB [OUTPUT_CHECKPOINT] + .TSB [FIELD_COUNT] + .LEFT_FILL);

			incr INDEX from 1 to .RIGHT_FILL do
			    ch$wchar_a (SPACE, DST_PTR);

			TSB [OUTPUT_PTR] = ch$plus (.TSB [OUTPUT_START],
			    .TSB [FIELD_WIDTH] + .TSB [OUTPUT_CHECKPOINT]);
			TSB [OUTPUT_COUNT] = .TSB [OUTPUT_CHECKPOINT] + .TSB [FIELD_WIDTH];
			end;
		    tes;

    end;					! End of JUSTIFY_FIELD
routine $C5TA (TSB, VALUE) : novalue =

!++
! Functional description:
!
!       Convert from a RAD50 value  to an ASCII string.  This  routine
!       converts a 16  bit value  (3 characters)  on -11  and -32  bit
!       machines and  a  fullword  value (5  characters)  on  -36  bit
!       machines.
!
! Formal parameters:
!
!	.TSB		Address of text state block.
!	.VALUE		The value to convert.
!
! Routine value: none
! Side effects: none
!
!--

    begin

    map
	TSB : ref TEXT_STATE_BLOCK;

    literal
	RESULT_LENGTH = %bliss36
	(5) %bliss32
	(3) %bliss16
	(3);

    local
	CHAR : vector [RESULT_LENGTH],		! Temporary holding area for characters
	WORKING_VALUE;

    WORKING_VALUE = .VALUE;
!
! Extract character by character
!

    incra INDEX from 0 to RESULT_LENGTH - 1 do
	CHAR [.INDEX] = CVTC (WORKING_VALUE);

!
! Output characters in reverse order from extraction
!

    decra INDEX from RESULT_LENGTH - 1 to 0 do
	CHAR_OUT (.TSB, .CHAR [.INDEX]);

    end;					! End of $C5TA
routine CVTC (VALUE_ADR) =

!++
! Functional description:
!
!       Reduce RAD50 value to components.
!
! Formal parameters:
!
!	.VALUE_ADR     Address of RAD50 value to reduce
!
! Routine value:
!
!	The next character extracted from ..VALUE_ADR
!
! Side effects: none
!
!	..VALUE_ADR    Returned with one character removed
!
!--

    begin

    bind
	RAD50_SET = ch$ptr (uplit (
         %bliss16 (%ascii ' ABCDEFGHIJKLMNOPQRSTUVWXYZ$.%0123456789')
         %bliss32 (%ascii ' ABCDEFGHIJKLMNOPQRSTUVWXYZ$.%0123456789')
         %bliss36 (%ascii ' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ.$%')));

    local
	CHAR;

    CHAR = ..VALUE_ADR mod %O'50';		! Pull the next character
    .VALUE_ADR = ..VALUE_ADR/%O'50';		! and divide it out.
    ch$rchar (ch$plus (RAD50_SET, .CHAR))
    end;					! End of CVTC
routine REPEAT (TSB) : novalue =

!++
! Functional description:
!
!       This routine "repeats" the given conversion
!       the specified number of times.
!
! Formal parameters:
!
!       .TSB            Address of text state block.
!
! Routine value: none
! Side effects: none
!
!--

    begin

    map
	TSB : ref TEXT_STATE_BLOCK;

    bind
	REPT = TSB [FIELD_REPEAT];

    while ((REPT = .REPT - 1) geq 0) and (.TSB [STATE] lss DONE) do
	begin
	TSB [FIELD_COUNT] = 0;
	TSB [OUTPUT_CHECKPOINT] = .TSB [OUTPUT_COUNT];
	NUMBER_CONVERSION (.TSB, NEXT_PARM (.TSB));
	JUSTIFICATION (.TSB);
	end;

    TSB [FIELD_JUSTIFY] = NO_FILL;
    end;					! End of REPEAT
routine NUMBER_CONVERSION (TSB, VALUE) : novalue =

!++
! Functional description:
!
!       Convert from a binary integer value to a ASCII string.  The
!       options for conversion are:
!
!          RADIX            Radix for conversion.
!          SIGNED           Whether value is to be interpreted as signed.
!          ZERO_SUPPRESS    Leading zero suppression.
!
! Formal parameters:
!
!	.TSB		Address of text state block.
!	.VALUE		The value to convert.
!
! Routine value: none
! Side effects: none
!
!--

    begin

    map
	TSB : ref TEXT_STATE_BLOCK;

    bind
	RADIX = TSB [FIELD_RADIX];

    local
	CHAR : vector [32],			! Holding area for remainders
	CHAR_ADR,				! Character position index
	FIELD_LENGTH,				! Length of receiving field
	WORKING_VALUE;				! This is our copy of his number.

    FIELD_LENGTH = min (32, .TSB [FIELD_WIDTH] - .TSB [FIELD_COUNT]);

    WORKING_VALUE =
	(if .TSB [FIELD_SIGNED] and (.VALUE lss 0)
	then
	    begin
	    CHAR_OUT (.TSB, %C'-');		! Insert a minus sign
	    -.VALUE				! Make positive.
	    end
	else .VALUE);				! Copy the number.

    !+
    ! Divide the value to death to get the individual digits.
    !-

    incra CHAR_ADR from CHAR [0] to CHAR [.FIELD_LENGTH - 1] by %upval do
	begin
	.CHAR_ADR = .WORKING_VALUE mod .RADIX;	! Save the remainder
	WORKING_VALUE = .WORKING_VALUE/.RADIX;	! and do the division.

	!+
	! Now turn the number into a digit. If the radix allows digits beyond 9,
	! map them up to 'A' through 'Z'.
	!-

	.CHAR_ADR = ..CHAR_ADR + (if ..CHAR_ADR gtr 9 then %C'A' - 10 else %C'0');

	!+
	! If we haven't run out of room in the output field, then check
	! for significant digit runout. If finished, shorten the field.
	!-

	if (.WORKING_VALUE eql 0) and .TSB [FIELD_ZERO_SUPPRESS]
	then exitloop (FIELD_LENGTH = (.CHAR_ADR - CHAR [0])/%upval + 1);

	end;

    !+
    ! The digits are extracted, output them.
    !-

    while (FIELD_LENGTH = .FIELD_LENGTH - 1) geq 0 do
	CHAR_OUT (.TSB, .CHAR [.FIELD_LENGTH]);

    end;					! End of NUMBER_CONVERSION
routine $CBDAT (TSB, VALUE) : novalue =

!++
! Functional description:
!
!       Convert from a binary integer value to a 2 digit ASCII
!       DECIMAL string.  This is useful for time and date string
!       conversions.
!
! Formal parameters:
!
!	.TSB		Address of text state block.
!	.VALUE		The value to convert.
!
! Routine value: none
! Side effects: none
!
!--

    begin

    map
	TSB : ref TEXT_STATE_BLOCK;

    literal
	RADIX = 10;

    local
	WIDTH_SAVE;

    WIDTH_SAVE = .TSB [FIELD_WIDTH];
    TSB [FIELD_WIDTH] = min (.TSB [FIELD_COUNT] + 2, .WIDTH_SAVE);
    TSB [FIELD_RADIX] = RADIX;
    NUMBER_CONVERSION (.TSB, .VALUE);
    TSB [FIELD_WIDTH] = .WIDTH_SAVE;
    end;					! End of $CBDAT
routine DATE_CONVERSION (TSB, DATE_BLOCK) : novalue =

!++
! Functional description:
!
!       Output the given date in the form: dd-mmm-yy.
!
! Formal parameters:
!
!       .TSB		Address of text state block
!	.DATE_BLOCK[0]	Year
!	.DATE_BLOCK[1]	Month (1-12)
!	.DATE_BLOCK[2]	Day (1-31)
!
! Routine value: none
! Side effects: none
!
!--

    begin

    map
	DATE_BLOCK : ref vector [3];

    local
	MONTH_PTR;

    bind
	MONTH = uplit (
                ch$ptr (uplit('JAN')), ch$ptr (uplit('FEB')),
                ch$ptr (uplit('MAR')), ch$ptr (uplit('APR')),
                ch$ptr (uplit('MAY')), ch$ptr (uplit('JUN')),
                ch$ptr (uplit('JUL')), ch$ptr (uplit('AUG')),
		ch$ptr (uplit('SEP')), ch$ptr (uplit('OCT')),
                ch$ptr (uplit('NOV')), ch$ptr (uplit('DEC')))
                       : vector [12];

!
! Output day
!
    $CBDAT (.TSB, .DATE_BLOCK [2]);
    CHAR_OUT (.TSB, %C'-');
!
! Output month
!
    MONTH_PTR = .MONTH [.DATE_BLOCK [1] - 1];
    CHAR_OUT (.TSB, ch$rchar_a (MONTH_PTR));
    CHAR_OUT (.TSB, ch$rchar_a (MONTH_PTR));
    CHAR_OUT (.TSB, ch$rchar_a (MONTH_PTR));
    CHAR_OUT (.TSB, %C'-');
!
! Output year
!
    $CBDAT (.TSB, .DATE_BLOCK [0]);
    end;					! End of DATE_CONVERSION
routine TIME_CONVERSION (TSB, TIM_BLOK, FORMAT) : novalue =

!++
! Functional description:
!
!       Output the given time in the form HH:MM:SS.S where
!       the resolution is controlled by the FORMAT parameter.
!
! Formal parameters:
!
!	.TSB		Address of text state block.
!	.TIM_BLOK[0]	Hour in day.
!	.TIM_BLOK[1]	Minute in hour.
!	.TIM_BLOK[2]	Second in minute.
!	.TIM_BLOK[3]	Tick in second.
!	.TIM_BLOK[4]	Number of ticks in a second.
!	.FORMAT		Indicates the format to use:
!			0 or 1 - HH
!			   2   - HH:MM
!			   3   - HH:MM:SS
!			4 or 5 - HH:MM:SS.S
!
! Routine value: none
! Side effects: none
!
!--

    begin

    map
	TSB : ref TEXT_STATE_BLOCK,
	TIM_BLOK : ref vector [5];

    TSB [FIELD_ZERO_SUPPRESS] = $false;

    select .FORMAT of
	set

	[0 TO 5] :
	    $CBDAT (.TSB, .TIM_BLOK [0]);

	[2 TO 5] :
	    begin
	    CHAR_OUT (.TSB, %C':');
	    $CBDAT (.TSB, .TIM_BLOK [1]);
	    end;

	[3 TO 5] :
	    begin
	    CHAR_OUT (.TSB, %C':');
	    $CBDAT (.TSB, .TIM_BLOK [2]);
	    end;

	[4 TO 5] :
	    begin
	    CHAR_OUT (.TSB, %C'.');
	    $CBDAT (.TSB, ((.TIM_BLOK [3]*100)/.TIM_BLOK [4]));
	    end;
	tes;

    end;					! End of TIME_CONVERSION
end						! End of module NMUTXT

eludom
! Local Modes:
! Mode:BLISS
! Auto Save Mode:0
! Comment Column:40
! Comment Rounding:+1
! End: