Columbia Kermit/kermit.zip/decpro300/prott.bli

Text File | 2020-01-01 | 9KB | 578 lines

MODULE KERTT (IDENT = '2.0.004'
        ) =
BEGIN

SWITCHES LANGUAGE (COMMON);

!<BLF/WIDTH:100>

!++
! FACILITY:
!
!    KERMIT text processing
!
! ABSTRACT:
!
!    This module contains all of the text processing required for
!    KERMSG.
!
! ENVIRONMENT:
!
!    TOPS-10, P/OS, VAX/VMS
!
! AUTHOR: Robert C. McQueen, CREATION DATE: 29-August-1983
!--


%SBTTL 'Table of Contents'
!
! TABLE OF CONTENTS:
!

%SBTTL 'Revision History'

!++
!
! Create this module for PRO/Kermit 1.0, Kermit-10 2(100) and Kermit-32 1.2
!
! 1.2.000    By: Robert C. McQueen            On: 29-August-1983
!        Create this module.
!
! 1.2.001    By: Robert C. McQueen        On: 9-Sept-1983
!        Make the string passed to TERM_DUMP a counted ASCIZ string,
!        not a counted ASCII string.
!
! 1.2.002    By: Robert C. McQueen        On: 16-September-1983
!        Make TT_OUTPUT a global routine, so we can force information
!        output a various points in time.
!
! 2.0.003    Release for TOPS-10 KERMIT-10 version 2.
!        Release for VAX/VMS KERMIT-32 version 2.
!
! 2.0.004    By: Nick Bush            On: 22-December-1983
!        Add TT_HOLD to indicate that output should not be dumped
!        when LF's are seen, only when buffer is full.
!--


%SBTTL 'Library files'
!
! INCLUDE FILES:
!
!
! KERMIT common definitions
!

REQUIRE 'KERCOM';


%SBTTL 'Symbol definitions'
!
! EQUATED SYMBOLS:
!

LITERAL
    TEXT_BFR_LENGTH = 256;            ! Length of the text buffer


%SBTTL 'Storage'
!
! OWN STORAGE:
!
!
! TT_xxxxx routine storage
!

OWN
    HOLD_FLAG,                    ! Output should be held even if CRLF seen
    DUMP_ROUTINE,                ! Address of routine to dump text
    TEXT_COUNT,                    ! Count of the characters
    TEXT_POINTER,                ! Pointer to store characters
    TEXT_BUFFER : VECTOR [CH$ALLOCATION (TEXT_BFR_LENGTH)];    ! Buffer of characters


%SBTTL 'External storage'

!++
! The following is the various external storage locations that are
! referenced from this module.
!--

!
! KERMSG storage
!

EXTERNAL
    CONNECT_FLAG;                ! Flag if communications line is TT:

!++
! The following is the only external routine used by this module.  This
! routine will cause the terminal buffer that we have been building to be
! output on the terminal
!--

EXTERNAL ROUTINE
    TERM_DUMP : NOVALUE;            ! Output the terminal buffer


%SBTTL 'Terminal routines -- TT_INIT - Initialize this module'

GLOBAL ROUTINE TT_INIT : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will initialize the terminal processing module.  It will
!    initialize the various data locations in this module.
!
! CALLING SEQUENCE:
!
!    TT_INIT();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
!
! Now initialize the various pointers
!
    TEXT_COUNT = 0;
    TEXT_POINTER = CH$PTR (TEXT_BUFFER);
    DUMP_ROUTINE = TERM_DUMP;            ! Initial output routine is to terminal
    HOLD_FLAG = FALSE;                ! Dump output on CRLF's
    END;                    ! End of TT_INIT


%SBTTL 'TT_SET_OUTPUT - Set output routine to use'

GLOBAL ROUTINE TT_SET_OUTPUT (OUT_RTN) =

!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will set the output routine to use for the TT_xxx routines.
!The argument is a routine address which will output a counted ASCIZ string.
!It will return the address of the previous output routine.
!
! CALLING SEQUENCE:
!
!    OLD_RTN = TT_SET_OUTPUT (OUT_RTN);
!
! INPUT PARAMETERS:
!
!    OUT_RTN - Address of routine to output a counted ASCIZ string
!        called as OUT_RTN (Address of string, length of string)
!
! IMPLICIT INPUTS:
!
!    DUMP_ROUTINE - Previous output routine
!
! OUPTUT PARAMETERS:
!
!    The value of the routine is the previous output routine address.
!
! IMPLICIT OUTPUTS:
!
!    DUMP_ROUTINE - New output routine
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LOCAL
    OLD_RTN;                ! Old routine address

    OLD_RTN = .DUMP_ROUTINE;            ! Remember the old address
    DUMP_ROUTINE = .OUT_RTN;            ! Save the new
    RETURN .OLD_RTN;                ! And return the old value
    END;                    ! End of TT_SET_OUTPUT


%SBTTL 'TT_HOLD - Start holding text until TT_OUTPUT call'

GLOBAL ROUTINE TT_HOLD (FLAG) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine is called to start buffering an amount of data
!    which should not be output until TT_OUTPUT is called.  It
!    sets a flag to indicate that output should not be done on
!    CRLF's.
!
! CALLING SEQUENCE:
!
!    TT_HOLD (TRUE or FALSE);
!
! INPUT PARAMETERS:
!
!    FLAG - True if output should be held past LF's.  False if output
!           should be dumped on each LF.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUPTUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    HOLD_FLAG is set to true.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    HOLD_FLAG = .FLAG;
    END;                    ! End of TT_HOLD


%SBTTL 'Terminal routines -- TT_OUTPUT - Output the buffer'

GLOBAL ROUTINE TT_OUTPUT : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will dump the text buffer on the output device.
!
! CALLING SEQUENCE:
!
!    TT_OUTPUT();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LOCAL
    STATUS;                    ! Status returned by the library routine

!
! Output the text
!
    CH$WCHAR_A (CHR_NUL, TEXT_POINTER);
    (.DUMP_ROUTINE) (TEXT_BUFFER, .TEXT_COUNT);    ! Output the buffer to the correct place
!
! Now reset the descriptor and the pointer to a virgin state
!
    TEXT_COUNT = 0;
    TEXT_POINTER = CH$PTR (TEXT_BUFFER);
!
    END;                    ! End of TT_OUTPUT


%SBTTL 'Terminal routines -- TT_CHAR - Output a single character'

GLOBAL ROUTINE TT_CHAR (CHARACTER) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will store a character into the text buffer.  It will
!    cause the text to be output if the character is a line terminator.
!
! CALLING SEQUENCE:
!
!    TT_CHAR(Character);
!
! INPUT PARAMETERS:
!
!    Character - Character to store into the text buffer.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
!
! Increment the count of the characters
!
    TEXT_COUNT = .TEXT_COUNT + 1;
!
! And store the character
!
    CH$WCHAR_A (.CHARACTER, TEXT_POINTER);
!
! If this is a line feed then just output the text string
!

    IF (.CHARACTER EQL CHR_LFD) AND NOT .HOLD_FLAG THEN TT_OUTPUT ();

!
! Check to make sure we are not exceeding the limit of the buffer
!

    IF .TEXT_COUNT EQL TEXT_BFR_LENGTH - 1 THEN TT_OUTPUT ();

!
    END;                    ! End of TT_CHAR


%SBTTL 'Terminal routines -- TT_TEXT - Output a text string'

GLOBAL ROUTINE TT_TEXT (ADDRESS) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will output text on the user's terminal.  It will
!    assume that it must check to determine if it can output the text
!    or not.
!
! CALLING SEQUENCE:
!
!    TT_TEXT(TEXT_ADDRESS);
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LOCAL
    CHARACTER,                ! Character being processed
    ARG_POINTER;                ! Pointer to the argument's text

!
! Construct a pointer to the argument.
!
    ARG_POINTER = CH$PTR (.ADDRESS);
!
! Get the first character that was passed.
!
    CHARACTER = CH$RCHAR_A (ARG_POINTER);
!
! Loop reading characters and calling the output routine to process
! them
!

    WHILE .CHARACTER NEQ CHR_NUL DO
    BEGIN
    TT_CHAR (.CHARACTER);
    CHARACTER = CH$RCHAR_A (ARG_POINTER);
    END;

    END;                    ! End of TT_TEXT


%SBTTL 'Terminal routines -- TT_NUMBER - Output a three digit number'

GLOBAL ROUTINE TT_NUMBER (NUMBER) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will store a three digit number into the text buffer.
!    It will just return if the number is greater than 999.
!
! CALLING SEQUENCE:
!
!    TT_NUMBER(Value);
!
! INPUT PARAMETERS:
!
!    Value - Value to output.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    ROUTINE TT_NUM_WORKER (VALUE) : NOVALUE =
    BEGIN

    IF .VALUE LEQ 9
    THEN
        TT_CHAR (.VALUE + %C'0')
    ELSE
        BEGIN
        TT_NUM_WORKER (.VALUE/10);
        TT_CHAR ((.VALUE MOD 10) + %C'0');
        END;

    END;

    IF .NUMBER LSS 0
    THEN
    BEGIN
    TT_CHAR (%C'-');
    NUMBER = -.NUMBER;
    END;

    TT_NUM_WORKER (.NUMBER);
    END;                    ! End of TT_NUMBER


%SBTTL 'Terminal routines -- TT_CRLF - Output a CRLF'

GLOBAL ROUTINE TT_CRLF : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will cause the contents of the terminal buffer to be
!    output to SYS$OUTPUT:.
!
! CALLING SEQUENCE:
!
!    TT_CRLF();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    TT_CHAR (CHR_CRT);
    TT_CHAR (CHR_LFD);
    END;                    ! End of TT_CRLF


%SBTTL 'End of KERTRM'
END                        ! End of module

ELUDOM