Google
 

Trailing-Edge - PDP-10 Archives - BB-P363B-SM_1985 - mcb/nml/ncprsp.bli
There are 2 other files named ncprsp.bli in the archive. Click here to see a list.
! <BRANDT.DEVELOPMENT>NCPRSP.BLI.1 29-Sep-82 14:21:45, Edit by BRANDT
!
! Ident 41.
!   In NCP$DEQUEUE_RESPONSE do not release any memory for CANCELLED
!   requests without first checking to see if something has been
!   allocated.
!
! <BRANDT.DEVELOPMENT>NCPRSP.BLI.1 27-Sep-82 14:12:54, Edit by BRANDT
!
! Ident 40.
!   A minor cosmetic fix to FMT_ENTITY_HEADER to make the formatting
!   of the identification for loop nodes consistent with other nodes.
!
! <BRANDT.DEVELOPMENT>NCPRSP.BLI.1 14-Sep-82 17:21:32, Edit by BRANDT
!
! Ident 39.
!   Fix code for printing out test data bytes in error responses to
!   LOOP_ messages.
!
! <BRANDT.DEVELOPMENT>NCPRSP.BLI.1 1-Sep-82 14:12:23, Edit by BRANDT
!
! Ident 38.
!   In routine FMT_UNCODED_FIELD, fix the code that formats long fixed
!   binary fields.  The response message will have low order bytes
!   first.
!
! <BRANDT.DEVELOPMENT>NCPRSP.BLI.1 5-Aug-82 11:21:32, Edit by BRANDT
!
! Ident 37.
!   1) Change NCP$DEQUEUE_RESPONSE so that commands like SET KNOWN ...
!      and ZERO KNOWN ... produce output consistent with NM spec.
!   2) Rework edit 35.
!
! <BRANDT.DEVELOPMENT>NCPRSP.BLI.1 28-Jul-82 17:12:23, Edit by BRANDT
!
! Ident 36.
!   1) In NCP$DEQUEUE_RESPONSE set RESPONSE_DATA flag in request block
!      when response message indicates an error.  That way, we don't get
!      "No Information" with an error message.
!
! <BRANDT.DEVELOPMENT>NCPRSP.BLI.1 28-Jun-82 10:12:23, Edit by BRANDT
!
! Ident 35.
!   1) In NCP$DEQUEUE_RESPONSE do not call FMT_ENTITY_HEADER to
!      format the entity from the response message if we are processing
!      an error.  Call GET_ENTITY_ID directly and thus avoid such
!      constructs as LOOP NODE = FOO, when FOO is an unrecognized
!      node name.
!
! <BRANDT.DEVELOPMENT>NCPRSP.BLI.2 7-Jun-82 11:21:45, Edit by BRANDT
!
! Ident 34.
!   1) In NCP$DEQUEUE_RESPONSE release memory allocated for node_id
!      in the request block.  Before this edit, this memory was
!      released in NML$NICE_EXECUTE.  Doing so allowed the memory to
!      be reallocated while still being referenced as a node_id.
!      Yep!  You guessed it.  Strange, occasional errors.
!
! <BRANDT.DEVELOPMENT>NCPRSP.BLI.2 13-May-82 9:12:45, Edit by BRANDT
!
! Ident 33.
!   1) In NCP$DEQUEUE_RESPONSE make changes required to handle partial
!      response messages (code of 3)
!   2) In FMT_RESPONSE_DATA, terminate text message with a blank and
!      null rather than a CR and null.
!
! <BRANDT.DEVELOPMENT>NCPRSP.BLI.2 10-May-82 10:21:54, Edit by BRANDT
!
! Ident 32.
!   1) Remove calls to FMT_ERROR_INFO and FMT_ENTITY_HEADER for response
!      messages with a code of 2 or -128.
!
! <BRANDT.DEVELOPMENT>NCPRSP.BLI.2 29-Apr-82 15:12:11, Edit by BRANDT
!
! Ident 31.
!   1) Change FMT_ERROR_DETAIL so it will not return FALSE if
!      .ERR_DETAIL value is 0, since this could be a valid value for
!      some error codes.  (URC for example!)
!   2) Change FMT_ERROR_INFO so it will call FMT_ERROR_DETAIL only if
!      the response code indicates an error.
!   3) Make FMT_ERROR_INFO a "no value" function.
!   4) Add a parameter to GET_COMMAND_NAME so that function can also
!      return a pointer to the type of information requested on read
!      commands.
!   5) Fix up FMT_HEADER routine and calls to it so that messages
!      conform (more or less) to the Network Management Spec.
!   6) Change GET_ENTITY_NAME so that the string returned will include
!      the specific class of entity, if applicable. (i.e., KNOWN,
!      ACTIVE, LOOP, or EXECUTOR)
!   7) Change FMT_RESPONSE_DATA to fix the "No Information" problem
!      by keeping a flag in the request block that indicates if any
!      data is returned for the request.  This fix makes SHOW KNOWN ...
!      work.
!
! NET:<VOBA.NML.DEVELOPMENT>NCPRSP.BLI.4  9-Apr-82 15:07:05, Edit by VOBA
!
! Ident 30.
! Fix FMT_UNCODED_FIELD to display binary image field with specific format.
!
! <VOBA.NML.DEVELOPMENT>NCPRSP.BLI.4  8-Apr-82 14:06:33, Edit by VOBA
!
! Ident 29.
! Fix bug in parsing binary image field data in routine FMT_UNCODED_FIELD.
!
! NET:<VOBA.NML.DEVELOPMENT>NCPRSP.BLI.32 25-Mar-82 15:54:40, Edit by VOBA
!
! Ident 28.
! Change code to format response message display for qualified MODULE
! parameters.
! Fix code to display cluster of returned parameters in the same entry.
! Fix code to use field definitions of NICE options.
!
! NET:<PECKHAM.DEVELOPMENT>NCPRSP.BLI.6 26-Feb-82 14:06:39, Edit by PECKHAM
!
! Ident 27.
! Move error detail text to NMARCH.
! Surround response texts by $NML$TEXT and convert to lower case;
! $NML$TEXT in NMARCH can be made to raise case if necessary.
! Produce error if NMU$MEMORY_GET fails in NCP$DEQUEUE_RESPONSE.
!
! <VOBA.NML.DEVELOPMENT>NCPRSP.BLI.3 24-Feb-82 08:12:30, Edit by VOBA
!
! Ident 26.
! Fix 'No Information' by
!   1) Get NICE return code in NCP$DEQUEUE_RESPONSE
!   2) Passing return code to FMT_RESPONSE_DATA
!   3) Displaying 'No Information' if command was READ_ and the return code
!      is not 2 (meaning separated data responses are coming)
!
! NET:<PECKHAM.DEVELOPMENT>NCPRSP.BLI.7 22-Feb-82 10:46:14, Edit by PECKHAM
!
! Ident 25.
! Change GET_ERR_DETAIL into FMT_ERR_DETAIL,
! Make it insert the error detail response text,
! and interpret the error detail information.
! Change GET_ENTITY_NAME to return null pointer with unidentified entity.
! Set up $RSP_TEXT to parenthesize statement and use this great macro!
!
! NET:<PECKHAM.DEVELOPMENT>NCPRSP.BLI.2 19-Feb-82 20:52:00, Edit by PECKHAM
!
! Ident 24.
! Fix LOGGING entity display in FMT_ENTITY_HEADER.
! Fix LOGGING entity verification in GET_ENTITY_ID.
! Re-install 'No Information' by
!   1) Getting NICE command code in NCP$DEQUEUE_RESPONSE
!   2) Passing command code to FMT_RESPONSE_DATA
!   3) Displaying 'No Information' if command was READ_
!
! NET:<VOBA.NML.DEVELOPMENT>NCPRSP.BLI.3 19-Feb-82 11:54:28, Edit by VOBA
!
! Ident 23.
! Removed unused debugging local variables.
!
! NET:<VOBA.NML.DEVELOPMENT>NCPRSP.BLI.13 16-Feb-82 15:05:45, Edit by VOBA
!
! Ident 22.
! Replacing old debugging code (check %O'135') with %debug macro.
!
! NET:<PECKHAM.DEVELOPMENT>NCPRSP.BLI.2  8-Feb-82 08:10:07, Edit by PECKHAM
!
! Ident 21.
! The 'No Information' response was not well thought out -
! the SET command has no information in the response!
! Remove the 'No Information'.
!
! NET:<PECKHAM.DEVELOPMENT>NCPRSP.BLI.2  8-Feb-82 07:40:43, Edit by PECKHAM
!
! Ident 20.
! Fix bug introduced in #19.
!
! NET:<PECKHAM.DEVELOPMENT>NCPRSP.BLI.3  7-Feb-82 16:32:30, Edit by PECKHAM
!
! Ident 19.
! Add 'No Information' response when no response data given
! in FMT_RESPONSE_DATA.
! Add MAX_VALUE to INTERPRET_COUNTER to identify counter overflow.
!
! NET:<BRANDT.DEVELOPMENT>NCPRSP.BLI.3 18-Jan-82 16:22:11, Edit by BRANDT
!
! Ident 18.
!   Change routine GET_ERR_DETAIL so that response messages with an
!   error detail field equal to 65535 (applicable but not available)
!   will not have any text printed.
!
! NET:<BRANDT.DEVELOPMENT>NCPRSP.BLI.2 15-Jan-82 15:12:11, Edit by BRANDT
!
! Ident 17.
!   Change NCP$DEQUEUE_RESPONSE to handle error messages that might
!   be part of a sequence of response messages.
!
! NET:<BRANDT.DEVELOPMENT>NCPRSP.BLI.2 11-Jan-82 15:57:11, Edit by BRANDT
!
! Ident 16.
! Add support to allow multiple NICE response text to be returned in a
! single IPCF packet. Handle overflow of text to more than one IPCF
! packet.
! Update copyright date to 1982.
!
! NET:<DECNET20-V3P1.NCP.SOURCES>NCPRSP.BLI.6  9-Oct-81 15:38:11, Edit by WEBBER
!
! Ident 15.
! Change blanks to tabs in counter formatting.
!
! NET:<DECNET20-V3P1.NCP.SOURCES>NCPRSP.BLI.6  7-Oct-81 9:54:26, Edit by WEBBER
!
! Ident 14.
! Fix counter formatting code.
!
! NET:<DECNET20-V3P1.NCP.SOURCES>NCPRSP.BLI.5  1-Oct-81 15:17:54, Edit by WEBBER
!
! Ident 13.
! Add code to get counter/bitmap text string.
!
! NET:<DECNET20-V3P1.BASELEVEL-2.SOURCES>NCPRSP.BLI.38  6-Aug-81 14:34:34, Edit by JENNESS
!
! Ident 12.
! Add return codes -100 to -103.  (DECnet-10/20 specific).
!
! NET:<DECNET20-V3P1.NCP.SOURCES>NCPRSP.BLI.5 12-May-81 13:29:37, Edit by GUNN
!
! Ident 11.
! Fix typo from last edit. Change %upval to %bpval.
! Bump RESP_PTR after saving for use in long binary value.
!
! NET:<DECNET20-V3P1.NCP.SOURCES>NCPRSP.BLI.2 12-May-81 10:09:02, Edit by GUNN
!
! Ident 10.
! Fix FMT_UNCODED_FIELD to handle long binary values correctly.
!
! NET:<DECNET20-V3P1.NCP.SOURCES>NCPRSP.BLI.9 16-Apr-81 11:25:37, Edit by GUNN
!
! Add code to convert coded NODE parameters to text.
!
! NET:<DECNET20-V3P1.NCP.SOURCES>NCPRSP.BLI.7 15-Apr-81 17:16:58, Edit by GUNN
!
! Add first level of code necessary to format names of parameters on output.
!
! NET:<DECNET20-V3P1.NML>NCPRSP.BLI.4 29-Mar-81 13:59:28, Edit by GUNN
!
! Change names of all routines beginning FORMAT_ to FMT_ making them
! unique to six characters, in order that they may be found when
! using DDT.
!
! NET:<DECNET20-V3P1.NML>NCPRSP.BLI.3 25-Mar-81 17:38:34, Edit by GUNN
!
! Increase size of text buffer used for response text.
! Change TEXT_BFR_SZ to TEXT_BUFFER_SIZE and add TEXT_BUFFER_LENGTH
! and TEXT_BUFFER_ALLOCATION for use where appropriate.
!
! NET:<DECNET20-V3P1.NML>NCPRSP.BLI.2 24-Mar-81 12:44:04, Edit by GUNN
!
! Release text buffer used in processing response.
!
! NET:<DECNET20-V3P1.BASELEVEL-2.SOURCES>NCPRSP.BLI.32 11-Feb-81 10:51:24, Edit by GUNN
!
! Send debugging output of response message contents back to operator in
! separate message. Large repsonse messages cause text buffer to overflow.
! Move call to text routine to end text with null byte into routine
! FMT_RESPONSE_DATA.
!
! NET:<DECNET20-V3P1.BASELEVEL-2.SOURCES>NCPRSP.BLI.30  9-Feb-81 14:57:24, Edit by GUNN
!
! Make output of uncoded parameter fields be dependent on DATA TYPE encoding.
! Output headers on multiple response sequence only first time.
! Special case test for length of node name in response message to account
! for bit 7 being set to indicate "EXECUTOR" node.
! Change output of node address to decimal.
!
! NET:<DECNET20-V3P1.BASELEVEL-2.SOURCES>NCPRSP.BLI.22  5-Feb-81 17:38:43, Edit by GUNN
!
! Handle multiple coded fields in response parameters properly. Loop was
! executed once too many times.
!
! NET:<DECNET20-V3P1.BASELEVEL-2.SOURCES>NCPRSP.BLI.21  4-Feb-81 19:43:29, Edit by GUNN
!
! Make release of memory resources associated with request storage be
! dependent on RB_STATE being set to RB$DONE.
!
! Update copyright date to 1981.
!
%title 'NCPRSP -- Process NICE Response Message'
module NCPRSP	(
		ident = 'X03.41'
		) =
begin

!                    COPYRIGHT (c) 1980, 1981, 1982
!                    DIGITAL EQUIPMENT CORPORATION
!                        Maynard, Massachusetts
!
!     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:	DECnet-10/20 V3.0 Network Control Program (NCP)
!
! ABSTRACT:
!
!	Performs processing of NICE response messages. Called by NML request
!	queue manager at request completion time. Transforms the NICE response
!	message to a text message and calls NCP$SEND_RESPONSE to transmit the
!	message text to the operator.
!
! ENVIRONMENT:	TOPS-10/20 User mode under NML
!
! AUTHOR: Dale C. Gunn , CREATION DATE:  8-Oct-80
!
! MODIFIED BY:
!
!	, : VERSION
! 01	-
!--
!
! INCLUDE FILES:
!

library 'NCPLIB';                       ! All required definitions
require 'NCPEXT';                       ! NCP External Names

!
! TABLE OF CONTENTS
!

forward routine
	NCP$DEQUEUE_RESPONSE: novalue,
        GET_COMMAND_NAME,
        GET_ENTITY_NAME,
        FMT_HEADER : novalue,
        FMT_ERROR_INFO : novalue,
        FMT_ERR_DETAIL,
        FMT_ENTITY_HEADER,
        GET_ERR_MESSAGE,
        GET_ENTITY_ID,
        GET_LINK_ERR_TEXT,
        GET_FILE_ERR_TEXT,
        FMT_RESPONSE_DATA,
        FMT_COUNTER,
        INTERPRET_COUNTER,
        FMT_PARAMETER : novalue,
        FMT_SINGLE_CODED_FIELD : novalue,
        FMT_UNCODED_FIELD : novalue;
%sbttl 'Macro Definitions'

macro
     NEXTB_RESP =
         NEXTB (.RESP_LEN,RESP_POS) %;

macro
     NEXTF_RESP =
         NEXTF (.RESP_LEN,RESP_POS,.RESP_PTR) %;

macro
     NEXTW_RESP =
         NEXTW (.RESP_LEN,RESP_POS) %;

macro
     NEXTN_RESP (N) =
         NEXTN (.RESP_LEN,RESP_POS,N) %;

!
! Macro to perform text output. Updates pointer to next available byte of
! text and current text length available.
!

macro
     $RSP_TEXT (FMT) =
         (TEXT_LENGTH = .TEXT_LENGTH +
                        $NMU$TEXT (TEXT_PTR,
                                   (TEXT_BUFFER_LENGTH-.TEXT_LENGTH),
                                   FMT
                                   %if %length gtr 1
                                   %then ,%remaining
                                   %fi)) %;

$show (all);

$field TABLE_ENTRY_FIELDS =
    set
    NICE_PARAMETER_NUMBER = [$integer],
    NICE_PARAMETER_ENTRY = [$address]
    tes;

literal
    TABLE_ENTRY_SIZE = $field_set_size;

macro
     NICE_PARAMETER_TABLE_ENTRY =
         block [TABLE_ENTRY_SIZE] field (TABLE_ENTRY_FIELDS) %;

$field PARAMETER_ENTRY_FIELDS =
    set
    %if not $MCB %then
    _NAME = [$pointer],                 ! Pointer to parameter name text
    %fi

    _DATA_FORMAT = [$byte],             ! Data format code
    _DATA_TYPE = [$byte],               ! Data type byte

        $align (byte)                   ! Restrictions
    _NML_PARAMETER = [$bit],            ! ON if NML owns this parameter
    _SETTABILITY = [$bits(2)],
    _APPLICABILITY = [$bits(5)],
        $overlay (_SETTABILITY)         ! Settability restrictions
    _READ_ONLY = [$bit],
    _WRITE_ONLY = [$bit],
        $continue
        $overlay (_APPLICABILITY)       ! Applicability restrictions
    _QUALIFIED = [$bit],
    _EXECUTOR_ONLY = [$bit],
    _OTHER_NODES = [$bits(3)],
        $overlay (_OTHER_NODES)
    _ADJACENT_ONLY = [$bit],
    _REMOTE_ONLY = [$bit],
    _SINK_ONLY = [$bit],
        $continue
        $continue

        $align (byte)                   ! Information type applicability
    _CHARACTERISTIC = [$bit],
    _STATUS = [$bit],
    _SUMMARY = [$bit],
    _EVENTS = [$bit],
    _QUALIFIER = [$bit]
    tes;

literal
    PARAMETER_ENTRY_SIZE = $field_set_size;

macro
     PARAMETER_ENTRY =
         block [PARAMETER_ENTRY_SIZE] field (PARAMETER_ENTRY_FIELDS) %;

$show (none);
%sbttl 'Equated Symbols'

%module_name ('NCPRSP');                ! Declare tracing facility

literal
    TEXT_BUFFER_LENGTH = 2534,          ! Maximum characters in IPCF response
    TEXT_BUFFER_SIZE = ch$allocation (TEXT_BUFFER_LENGTH), ! In words
    TEXT_BUFFER_ALLOCATION = TEXT_BUFFER_SIZE * %upval;

!
! OWN STORAGE:
!

own
   RESP_LEN,                            ! Length of response message
   RESP_POS,                            ! Current position in response message
   NICE_PTR,                            ! Character pointer to NICE message
   RESP_PTR,                            ! Character pointer to NICE response
   TEXT_PTR,                            ! Character pointer text response msg
   TEXT_ADDR,                           ! Address of text buffer
   TEXT_LENGTH;                         ! Length of text message in characters

!
! EXTERNAL REFERENCES:
!

external
    %debug_data_base;

external routine
         PUTBUF,                        ! Debugging output in NCPCEX
         NCP$GET_ERR_TEXT,
         NCP$SEND_RESPONSE,
         NCP$SEND_TO_OPERATOR,
         NCP$LOG_TO_OPERATOR,
         NML$PARAMETER_TEXT,            ! Return text pointer to parameter name
         NML$PARAMETER_LOOKUP,          ! Return parameter data base entry
	 NCP$COUNTER_TEXT,		! Return text pointer to counter name
	 NCP$BIT_TEXT,			! Return text ptr to bitmap bit name
         NML$CODED_TEXT;                ! Return text pointer to coded text
%global_routine ('NCP$DEQUEUE_RESPONSE', REQ) : novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!       Called by the NML request manager as a completion routine
!       to process the response to a NICE request. Formats a message
!       text to be returned to the issuer of the NCP command which
!       caused the request to be generated. The text is formatted
!       in accordance with the NICE request and response messages
!       pointed to by the request block.
!
! FORMAL PARAMETERS
!
!
!	REQ  - Address of the NML request block.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    begin

    own
	 LAST_RTN_CODE: block[1] initial(0); ! From previous resp msg

    local
         CMD_CODE,                      ! Command code
         CMD_PTR,                       ! Pointer to command name
         ENT_PTR,                       ! Pointer to entity type name
         EID_PTR,                       ! Pointer to entity ID
         EID_LEN,                       ! Entity ID len
         NOD_ADR,                       ! Temp variable
         INF_PTR,                       ! Pointer to info type string
         MSG_TYPE,                      ! Type of message to send to operator
         STS_PTR,                       ! Pointer to status string
         RTN_COD: $SIGNED_BYTE_VALUE,   ! NICE return code
         ENTITY_TYPE,                   ! Entity type number
         ERR_DETAIL,                    ! Value of error detail field
         REQ_DATA,                      ! Our special data
	 T1,				! Temporary
	 T2,				! Temporary
	 T3,				! Temporary
         TEMP;                          ! Local work variable

    map
       REQ: ref REQUEST_BLOCK,          ! Make fields addressable
       REQ_DATA: ref XCTR_BLOCK;        ! Make fields addressable

    if .REQ[RB_STATE] eql RB$CANCELLED  ! Request was cancelled
    then begin                          ! Release all associated storage
	if ((.REQ[RB_DATA] neq 0) and
	    (.REQ[RB_DATA_ALLOCATION] neq 0))
        then NMU$MEMORY_RELEASE (.REQ[RB_DATA],.REQ[RB_DATA_ALLOCATION]);
	if ((.REQ[RB_RESPONSE] neq 0) and
	    (.REQ[RB_RESPONSE_ALLOCATION] neq 0))
        then NMU$MEMORY_RELEASE (.REQ[RB_RESPONSE],.REQ[RB_RESPONSE_ALLOCATION]);
	if ((.REQ[RB_NICE] neq 0) and
	    (.REQ[RB_NICE_ALLOCATION] neq 0))
        then NMU$MEMORY_RELEASE (.REQ[RB_NICE],.REQ[RB_NICE_ALLOCATION]);
	if .REQ[RB_NICE_ENTITY_ADR] neq 0 ! Release node id buffer
	then NMU$MEMORY_RELEASE (.REQ[RB_NICE_ENTITY_ADR],
				 NODE_ID_BUFFER_ALLOCATION);
        NMU$MEMORY_RELEASE (.REQ,REQUEST_BLOCK_ALLOCATION);
        return;
        end;

    TEXT_ADDR = NMU$MEMORY_GET (TEXT_BUFFER_ALLOCATION); ! Allocate buffer

    if .TEXT_ADDR eql 0
    then $INTERNAL_ERROR$ ('Unable to get response text buffer');

    TEXT_PTR = ch$ptr(.TEXT_ADDR);      ! Initialize text pointer
    TEXT_LENGTH = 0;                    ! Length of text initially zero

    TEMP = .REQ[RB_TYPE];               ! Get request type RT$REMOTE/RT$LOCAL 
    NICE_PTR = ch$ptr(.REQ[RB_NICE],,8); ! Get pointer to NICE request
    TEMP = .REQ[RB_NICE_LENGTH];        ! And its length in bytes
    EID_PTR = ch$plus(.NICE_PTR,2);     ! Pointer to Entity ID
    REQ_DATA = .REQ[RB_DATA];           ! Address of NCP specific data
    RESP_LEN = .REQ[RB_RESPONSE_LENGTH]; ! Length of response message
    RESP_PTR = ch$ptr (.REQ[RB_RESPONSE],,8); ! Get pointer to NICE response 

!
! Analyze and convert NICE request to text
!

    CMD_CODE = ch$rchar (.NICE_PTR);
    CMD_PTR = GET_COMMAND_NAME (ENTITY_TYPE, INF_PTR, NICE_PTR);

    if .CMD_CODE neq READ_		! Only get expanded
    then				!  entity names
	EID_PTR = 0;			!  for SHOW command

    ENT_PTR = GET_ENTITY_NAME (.ENTITY_TYPE, .EID_PTR);

    if .ENT_PTR eqla 0
    then ENT_PTR = CH$ASCIZ ($NML$TEXT ('*Unknown Entity*'));

!
! Process NICE response message
!

    %debug (NCP_NICE_VALIDATION,        ! Debugging code
           (begin                       ! Used to print the content of the
            builtin LSH;                ! NICE message in ASCII text for
            local PAGE, PTR, TMP;       ! displaying in log file.

            PAGE = NMU$PAGE_GET ();
            PTR = TMP = ch$ptr (LSH (.PAGE,9));
            $NMU$TEXT (TMP, TEXT_BUFFER_LENGTH,
                       '%/[NICE Response Message]%/%N');
            PUTBUF (TMP, 0,             ! Format the NICE message
                    .REQ[RB_RESPONSE],
                    .REQ[RB_RESPONSE_LENGTH]);
            NCP$SEND_RESPONSE (0, .PTR, .REQ_DATA[OPR_ID]);
            NMU$PAGE_RELEASE (.PAGE);
            end));

    RESP_POS = 0;                       ! Initially at beginning of response
    MSG_TYPE = -1;			! Initially no message to operator
    STS_PTR = CH$ASCIZ ($NML$TEXT ('Completed')); ! Status

    if NEXTB_RESP
    then RTN_COD = GETB (RESP_PTR)      ! Get NICE return code
    else $INTERNAL_ERROR$ ('Zero length response received');


    selectone .RTN_COD[VALUE] of        ! Process according to return code
        set
        [1]:                            ! Success
            begin
            if .REQ[RB_STATE] eql RB$DONE
            then MSG_TYPE = 0        ! Final and only operator message
            else MSG_TYPE = 2;       ! Part of multiple segment message

	    if ((.MSG_TYPE eql 0) or
		(.CMD_CODE eql CHANGE_) or
		(.CMD_CODE eql ZERO_))
	    then
                 FMT_HEADER (.REQ[RB_NUMBER],
                             .CMD_PTR,
                             .ENT_PTR,
                             .INF_PTR,
                             .STS_PTR);

            FMT_ERROR_INFO (.ENTITY_TYPE, ! Format any error info
                            .RTN_COD[VALUE],
			    ERR_DETAIL);

	    if .LAST_RTN_CODE neq 3	  ! If not more of a partial rsp
            then			  ! Format entity
	        FMT_ENTITY_HEADER (.ENTITY_TYPE,.RTN_COD[VALUE],.CMD_CODE)
	    else
		GET_ENTITY_ID (T1, T2, T3, .ENTITY_TYPE); ! Skip it

            FMT_RESPONSE_DATA (.ENTITY_TYPE, ! Format parameters
                               .CMD_CODE,
                               .REQ);
            end;

        [2]:                            ! Request accepted, more response 
            begin
	    if ((.CMD_CODE neq CHANGE_) and	! No header for SET
		(.CMD_CODE neq ZERO_))		!  or ZERO
	    then
		begin
                MSG_TYPE = 1;               ! First part of message
                FMT_HEADER (.REQ[RB_NUMBER],
                            .CMD_PTR,
                            .ENT_PTR,
                            .INF_PTR,
			    .STS_PTR);
                end;
            end;

        [3]:                            ! Success, partial reply
            begin
            MSG_TYPE = 2;               ! Part of multiple segment message
            FMT_ERROR_INFO (.ENTITY_TYPE, ! Format any error info
                            .RTN_COD[VALUE],
			    ERR_DETAIL);

	    if .LAST_RTN_CODE neq 3	  ! If not more of a partial rsp
            then			  ! Format entity
	        FMT_ENTITY_HEADER (.ENTITY_TYPE,.RTN_COD[VALUE],.CMD_CODE)
	    else
		GET_ENTITY_ID (T1, T2, T3, .ENTITY_TYPE); ! Skip it

            FMT_RESPONSE_DATA (.ENTITY_TYPE, ! Format parameters
                               .CMD_CODE,
                               .REQ);
            end;

        [-29 to -1,
         -103 to -100]:                 ! Error
            begin
            if ((.REQ[RB_STATE] eql RB$DONE) or
	        (.CMD_CODE eql CHANGE_) or
		(.CMD_CODE eql ZERO_))
            then begin
                 MSG_TYPE = 0;          ! Final and only operator message
                 STS_PTR = CH$ASCIZ ($NML$TEXT ('Failed')); ! Status
                 FMT_HEADER (.REQ[RB_NUMBER],
                             .CMD_PTR,
                             .ENT_PTR,
                             .INF_PTR,
                             .STS_PTR);
                 end
            else MSG_TYPE = 2;          ! Part of multiple part message

            TEMP = NCP$GET_ERR_TEXT (.RTN_COD[VALUE]); ! Get error text pointer
            $RSP_TEXT (', %#A%N', ch$rchar (ch$plus(.TEMP,-1)), .TEMP);

            FMT_ERROR_INFO (.ENTITY_TYPE, ! Format any error detail and text
                            .RTN_COD[VALUE],
			    ERR_DETAIL);

	    FMT_ENTITY_HEADER (.ENTITY_TYPE,.RTN_COD[VALUE],.CMD_CODE);

	    REQ[RB_RESPONSE_DATA] = 1;          ! Set flag non-zero

            if .REQ[RB_NICE_FUNCTION] eql LOOP_ ! TEST request response
            then begin                  	!  has special format
                 local TEST_DATA;

                 if NEXTW_RESP          ! TEST DATA field exist?
                 then begin
                      TEST_DATA = GETW (RESP_PTR); ! Get special code
                      if (.RTN_COD[VALUE] eql NICE$_IPV) ! Failed for invalid parm value
                      and (.ERR_DETAIL eql N$LLTH) ! Length parameter
                      then begin        ! Max test data length exceeded
                           $RSP_TEXT ($NML$TEXT ('%/ Maximum test data length = %D, exceeded%/'),
                                      .TEST_DATA);
                           end
                      else begin        ! Unlooped count
                           $RSP_TEXT ($NML$TEXT ('%/ Unlooped count = %D%/'),
                                      .TEST_DATA);
                           end;
                      end;
                  end
            else $RSP_TEXT ('%/');
            end;

        [-128]:                         ! Final multiple response
            begin
            MSG_TYPE = 3;               ! Last of multiple operator messages
            if ((.CMD_CODE eql READ_) and   ! Function is READ
                (.REQ[RB_RESPONSE_DATA] eql 0)) ! No data ever supplied
            then $RSP_TEXT ($NML$TEXT ('%/%/  No Information%/'));
            end;

        [otherwise]:                    ! Invalid return code
            begin
            MSG_TYPE = 0;               ! Final and only operator message
            STS_PTR = CH$ASCIZ ($NML$TEXT ('Failed')); ! Status
            FMT_HEADER (.REQ[RB_NUMBER],
                        .CMD_PTR,
                        .ENT_PTR,
                        0,	        ! No information type
                        .STS_PTR);
            $RSP_TEXT ($NML$TEXT (',%/Invalid NICE return code = (%D)%/'),
                       .RTN_COD);
            end;
        tes;

    LAST_RTN_CODE = .RTN_COD[VALUE];	! Remember return code

    !
    ! Send the response text back to operator
    !

    if .MSG_TYPE geq 0
    then NCP$SEND_RESPONSE (.MSG_TYPE,
                            ch$ptr (.TEXT_ADDR),
                            .REQ_DATA[OPR_ID]);

    !
    ! Release all storage associated with the request
    ! Release all memory resources when done
    !

    NMU$MEMORY_RELEASE (.TEXT_ADDR, TEXT_BUFFER_ALLOCATION);

    if .REQ[RB_STATE] eql RB$DONE
    then begin
         NMU$MEMORY_RELEASE (.REQ[RB_DATA], .REQ[RB_DATA_ALLOCATION]);
         NMU$MEMORY_RELEASE (.REQ[RB_RESPONSE], .REQ[RB_RESPONSE_ALLOCATION]);
         NMU$MEMORY_RELEASE (.REQ[RB_NICE], .REQ[RB_NICE_ALLOCATION]);
	 if .REQ[RB_NICE_ENTITY_ADR] neq 0 ! Release node id buffer
	 then NMU$MEMORY_RELEASE (.REQ[RB_NICE_ENTITY_ADR],
				  NODE_ID_BUFFER_ALLOCATION);
         NMU$MEMORY_RELEASE (.REQ, REQUEST_BLOCK_ALLOCATION);
         end;

    end;				! End of NCP$DEQUEUE_RESPONSE
%routine ('GET_COMMAND_NAME', ENTITY_TYPE_ADDR, INF_PTR_ADDR, NICE_PTR_ADDR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Determines the NCP command name string based on the NICE 
!       request message.
!
! FORMAL PARAMETERS
!
!	ENTITY_TYPE_ADDR        The address of variable in which will be
!                               returned the entity type number found in
!                               the NICE message.
!
!	INF_PTR_ADDR            The address of variable in which will be
!                               returned a pointer to a string indicating
!                               the information type in a "read" NICE
!                               message.  For other NICE messages, this
!				variable will be set null.
!
!	NICE_PTR_ADDR           The address of a pointer to the beginning
!                               of a NICE request message.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
!
!	A character sequence pointer to the NCP command name string.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    begin

    local
	 TEMP;                          ! Local work variable

    .INF_PTR_ADDR = 0;			! Set null, initially

    TEMP = GETB (.NICE_PTR_ADDR);       ! Get the NICE function code

    case .TEMP from LOAD_ to SYSTEM_SPECIFIC_ of
        set
        [LOAD_]:                        ! Request down-line load
            begin
            local OPTION: block [1] field (LOAD_OPTIONS);

            TEMP = CH$ASCIZ ($NML$TEXT ('Load'));
            OPTION = GETB (.NICE_PTR_ADDR); ! Get option byte
            .ENTITY_TYPE_ADDR = .OPTION[LO_ENTITY_TYPE]; ! Get entity type
            end;

        [DUMP_]:                        ! Request up-line dump
            begin
            local OPTION: block [1] field (DUMP_OPTIONS);

            TEMP = CH$ASCIZ ($NML$TEXT ('Dump'));
            OPTION = GETB (.NICE_PTR_ADDR); ! Get option byte
            .ENTITY_TYPE_ADDR = .OPTION[DO_ENTITY_TYPE]; ! Get entity type
            end;

        [TRIGGER_]:                     ! Trigger bootstrap
            begin
            local OPTION: block [1] field (BOOT_OPTIONS);

            TEMP = CH$ASCIZ ($NML$TEXT ('Trigger'));
            OPTION = GETB (.NICE_PTR_ADDR); ! Get option byte
            .ENTITY_TYPE_ADDR = .OPTION[BO_ENTITY_TYPE]; ! Get entity type
            end;

        [LOOP_]:                        ! Test
            begin
            local OPTION: block [1] field (TEST_OPTIONS);

            TEMP = CH$ASCIZ ($NML$TEXT ('Loop'));
            OPTION = GETB (.NICE_PTR_ADDR); ! Get option byte
            .ENTITY_TYPE_ADDR = .OPTION[TO_ENTITY_TYPE]; ! Get entity type
            end;

        [SET_]:                         ! Change parameter
            begin
            local OPTION: block [1] field (CHANGE_OPTIONS);

            OPTION = GETB (.NICE_PTR_ADDR); ! Get option byte
            selectone .OPTION[CO_FUNCTION_DATA] of
                set
                [00]: TEMP = CH$ASCIZ ($NML$TEXT ('Set'));
                [01]: TEMP = CH$ASCIZ ($NML$TEXT ('Clear'));
                [10]: TEMP = CH$ASCIZ ($NML$TEXT ('Define'));
                [11]: TEMP = CH$ASCIZ ($NML$TEXT ('Purge'));
                tes;

            .ENTITY_TYPE_ADDR = .OPTION[CO_ENTITY_TYPE]; ! Get entity type
            end;

        [SHOW_]:                        ! Read information
            begin
            local OPTION: block [1] field (READ_OPTIONS);

            OPTION = GETB (.NICE_PTR_ADDR); ! Get option byte
            selectone .OPTION[RO_PERMANENT] of
                set
                [0]: TEMP = CH$ASCIZ ($NML$TEXT ('Show'));
                [1]: TEMP = CH$ASCIZ ($NML$TEXT ('List'));
                tes;

            selectone .OPTION[RO_INFO_TYPE] of
                set
                [0]: .INF_PTR_ADDR = CH$ASCIZ ($NML$TEXT ('Summary '));
                [1]: .INF_PTR_ADDR = CH$ASCIZ ($NML$TEXT ('Status '));
                [2]: .INF_PTR_ADDR = CH$ASCIZ ($NML$TEXT ('Characteristics '));
                [3]: .INF_PTR_ADDR = CH$ASCIZ ($NML$TEXT ('Counters '));
                [4]: .INF_PTR_ADDR = CH$ASCIZ ($NML$TEXT ('Events '));
                tes;

            .ENTITY_TYPE_ADDR = .OPTION[RO_ENTITY_TYPE]; ! Get entity type
            end;

        [ZERO_]:                        ! Zero counters
            begin
            local OPTION: block [1] field (ZERO_OPTIONS);

            TEMP = CH$ASCIZ ($NML$TEXT ('Zero'));
            OPTION = GETB (.NICE_PTR_ADDR); ! Get option byte
            .ENTITY_TYPE_ADDR = .OPTION[ZO_ENTITY_TYPE]; ! Get entity type
            end;

        [SYSTEM_SPECIFIC_]:             ! System-specific function
            begin
            %( N.B. - Unknown for now until we know what system specific
                      functions we will be supporting. )%
            TEMP = CH$ASCIZ ($NML$TEXT ('*System Specific*'));
            .ENTITY_TYPE_ADDR = -1;     ! Set entity type invalid
            end;

        [inrange,
         outrange]:                     ! * Invalid *
            begin
            TEMP = CH$ASCIZ ($NML$TEXT ('*Unknown*'));
            .ENTITY_TYPE_ADDR = -1;     ! Set entity type invalid
            end;
        tes;

    return .TEMP;                       ! Returning pointer to command string
    end;				! End of GET_COMMAND_NAME
%routine ('GET_ENTITY_NAME', ENTITY_TYPE, EID_PTR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Converts the entity type number to a pointer to a string which
!       represents the name of the entity.
!
! FORMAL PARAMETERS
!
!	ENTITY_TYPE - A value which represents the entity type number.
!
!	EID_PTR - Pointer to the entity ID in NICE message
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
!
!	A character sequence pointer to the entity name string
!       or null pointer if unidentified.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    begin

    local
	EID_LEN: $SIGNED_BYTE_VALUE,
	PTR;				! Temporary loc for ptr

    PTR = .EID_PTR;
    EID_LEN = (if .PTR neq 0
               then GETB(PTR)
               else 0);

    return case .ENTITY_TYPE from NODE_E to MODULE_ of
        set
        [NODE_E]:
	    begin
	    local
		NODE_ID;		! Node address
	    selectone .EID_LEN[VALUE] of
		set
		[-1]: CH$ASCIZ ($NML$TEXT ('Known Nodes'));
		[-2]: CH$ASCIZ ($NML$TEXT ('Active Nodes'));
		[-3]: CH$ASCIZ ($NML$TEXT ('Loop Nodes'));
		[0]:
		    if .PTR neq 0
	            then
			begin
			NODE_ID = GETW (PTR);
			if .NODE_ID eql 0
			then CH$ASCIZ ($NML$TEXT ('Executor Node'))
			else CH$ASCIZ ($NML$TEXT ('Node'))
			end
		    else
			CH$ASCIZ ($NML$TEXT ('Node'));
		[otherwise]: CH$ASCIZ ($NML$TEXT ('Node'));
		tes
	    end;

        [LINE_]:
	    selectone .EID_LEN[VALUE] of
		set
		[-1]: CH$ASCIZ ($NML$TEXT ('Known Lines'));
		[-2]: CH$ASCIZ ($NML$TEXT ('Active Lines'));
		[otherwise]: CH$ASCIZ ($NML$TEXT ('Line'));
		tes;

        [LOGGING_]:
	    selectone .EID_LEN[VALUE] of
		set
		[-1]: CH$ASCIZ ($NML$TEXT ('Known Logging'));
		[-2]: CH$ASCIZ ($NML$TEXT ('Active Logging'));
		[otherwise]: CH$ASCIZ ($NML$TEXT ('Logging'));
		tes;

        [CIRCUIT_]:
	    selectone .EID_LEN[VALUE] of
		set
		[-1]: CH$ASCIZ ($NML$TEXT ('Known Circuits'));
		[-2]: CH$ASCIZ ($NML$TEXT ('Active Circuits'));
		[otherwise]: CH$ASCIZ ($NML$TEXT ('Circuit'));
		tes;

        [MODULE_]:
	    selectone .EID_LEN[VALUE] of
		set
		[-1]: CH$ASCIZ ($NML$TEXT ('Known Modules'));
		[-2]: CH$ASCIZ ($NML$TEXT ('Active Modules'));
		[otherwise]: CH$ASCIZ ($NML$TEXT ('Module'));
		tes;

        [inrange,
         outrange]: 0;
        tes;

    end;				! End of GET_ENTITY_NAME
%routine ('FMT_HEADER', REQ_NO, CMD_PTR, ENT_PTR, INF_PTR, STS_PTR) : novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Formats the initial header line of command response output.
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    begin

    !
    ! Build the text to describe the status of the command 
    !

    $RSP_TEXT (CH$ASCIZ($NML$TEXT ('Request # %D; %A %A %A%A%N')),
               .REQ_NO,                 ! Request id number
               .CMD_PTR,                ! Pointer to command name string
               .ENT_PTR,                ! Pointer to entity name string
               .INF_PTR,                ! Pointer to info_type string
               .STS_PTR);               ! Pointer to status string

    end;				! End of FMT_HEADER
%routine ('FMT_ERROR_INFO', ENTITY_TYPE, RTN_COD, ERR_DETAIL) : novalue =

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

    begin

    local
         ERR_LEN,                       ! Length of error message string
         ERR_PTR;                       ! Pointer to error message

    !
    ! If error detail field is present in message build format pattern
    ! to show its contents
    !

    if NEXTW_RESP                       ! Room for error detail?
    then begin                          ! Yes,
         .ERR_DETAIL = GETW (RESP_PTR);  ! Extract it

         if (.RTN_COD lss 0 and .RTN_COD gtr -128) ! Is it applicable?
	 then FMT_ERR_DETAIL (.ENTITY_TYPE, .RTN_COD, ..ERR_DETAIL);

    !
    ! Add error message text if present
    !

         if GET_ERR_MESSAGE (ERR_LEN,ERR_PTR)
         then $RSP_TEXT (',%/%#A %/%N', .ERR_LEN, .ERR_PTR);
         end;

    end;				! End of FMT_ERROR_INFO
%routine ('FMT_ERR_DETAIL', ENTITY_TYPE, RTN_COD, ERR_DETAIL) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Formats the error detail part of the message, if applicable.
!
! FORMAL PARAMETERS
!
!	ENTITY_TYPE - The entity type number to which this request was
!                     issued.
!	RTN_COD - The NICE return code from the response message.
!	ERR_DETAIL - The error detail value.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
!
!	$TRUE - if error detail was applicable.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    begin

!
! The error detail field was present in the NICE response message
! so process it accordingly.
!

    if (.ERR_DETAIL eql 65535)          ! Error detail present but
    then return $FALSE;                 !  Not Applicable

    selectone .RTN_COD of
        set
        [NICE$_UPT,                     !  Unrecognized parameter type
         NICE$_IPV,                     !  Invalid parameter value
         NICE$_PNA,                     !  Parameter not applicable
         NICE$_PVL,                     !  Parameter value too long
         NICE$_PAM]:                    !  Parameter missing
            begin                       ! Display parameter type number
            local PRM_TXT_PTR;

            PRM_TXT_PTR = NML$PARAMETER_TEXT (.ENTITY_TYPE, .ERR_DETAIL);

            if .PRM_TXT_PTR neq 0
            then $RSP_TEXT (CH$ASCIZ ($NML$TEXT (',%/Parameter = %#A%N')),
                            ch$rchar_a (PRM_TXT_PTR),
                            .PRM_TXT_PTR)
            else $RSP_TEXT (CH$ASCIZ ($NML$TEXT (',%/Parameter #%D%N')),
                            .ERR_DETAIL);

            return $TRUE;
            end;

        [NICE$_URC,                     !  Unrecognized component
         NICE$_IID,                     !  Invalid identification
         NICE$_CWS]:                    !  Component in wrong state
            begin                       ! Display entity type number
            local ENT_TXT_PTR;

            if .ERR_DETAIL eql NO_ENTITY_
            then begin
                 $RSP_TEXT (CH$ASCIZ ($NML$TEXT (',%/No entity%N')));

                 return $TRUE;
                 end;

            ENT_TXT_PTR = GET_ENTITY_NAME (.ERR_DETAIL, 0);

            if .ENT_TXT_PTR neq 0
            then begin
                 $RSP_TEXT (CH$ASCIZ ($NML$TEXT (',%/Entity = %A%N')),
                            .ENT_TXT_PTR);

                 return $TRUE;
                 end;
            end;

        [NICE$_FOE,                     ! File open error
         NICE$_IFC,                     ! Invalid file contents
         NICE$_FIO]:                    ! File I/O error
            begin                       ! Display file type code
            local FIL_TXT_PTR;

            FIL_TXT_PTR = GET_FILE_ERR_TEXT (.ERR_DETAIL);

            if .FIL_TXT_PTR neq 0
            then begin
                 $RSP_TEXT (CH$ASCIZ ($NML$TEXT (',%/File = %#A%N')),
                            ch$rchar (ch$plus (.FIL_TXT_PTR, -1)),
                            .FIL_TXT_PTR);

                 return $TRUE;
                 end;
            end;

        [NICE$_MLD,                     ! Mirror link disconnected
         NICE$_MCF,                     ! Mirror connect failed
         NICE$_LLD,                     ! Listener Link Disconnected
         NICE$_LCF]:                    ! Listener link connect failed
            begin                       ! Display link fail code
            local LNK_TXT_PTR;

            LNK_TXT_PTR = GET_LINK_ERR_TEXT (.ERR_DETAIL);

            if .LNK_TXT_PTR neq 0
            then begin
                 $RSP_TEXT (CH$ASCIZ ($NML$TEXT (',%/Link Failure = %#A%N')),
                            ch$rchar (ch$plus (.LNK_TXT_PTR, -1)),
                            .LNK_TXT_PTR);

                 return $TRUE;
                 end;
            end;
        tes;

    $RSP_TEXT (CH$ASCIZ ($NML$TEXT (',%/Error detail = %D%N')), .ERR_DETAIL);

    return $TRUE;
    end;				! End of FMT_ERR_DETAIL
%routine ('FMT_ENTITY_HEADER', ENTITY_TYPE, CODE, COMMAND) =

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

    begin

    bind
        LOGGING_CONSOLE_PTR = ch$asciz ($NML$TEXT ('Console')),
        LOGGING_FILE_PTR = ch$asciz ($NML$TEXT ('File')),
        LOGGING_MONITOR_PTR = ch$asciz ($NML$TEXT ('Monitor')),
        LOGGING_EIDS = uplit (LOGGING_CONSOLE_PTR,
                              LOGGING_FILE_PTR,
                              LOGGING_MONITOR_PTR) : vector [3];

    local
         FMT_PTR,                       ! Pointer to format text
         EID_PTR,                       ! Pointer to entity id string
         EID_LEN,                       ! Entity id length
         NOD_ADR;                       ! Node address

    !
    ! Attempt to get pointer to entity id in response message. 
    ! If none exists return false.
    !

    if not GET_ENTITY_ID (NOD_ADR, EID_LEN, EID_PTR, .ENTITY_TYPE)
    then return $FALSE;

    !
    ! Format of entity descriptor line depends on entity type
    !

    case .ENTITY_TYPE from NODE_E to MODULE_ of
        set
        [NODE_E]:
            begin
            if .EID_LEN<7,1> eql 1      ! Is it Executor node?
            then begin
                 EID_LEN<7,1> = 0;      ! Clear Executor indicator
                 FMT_PTR = CH$ASCIZ ($NML$TEXT ('Executor Node = %M (%#A)%/%N'));
                 end
            else if .NOD_ADR eql 0      ! Is it Loop node?
                 then if .CODE geq 0
		      then FMT_PTR = CH$ASCIZ ($NML$TEXT ('Loop Node = %+(%#A)%/%N')) 
		      else FMT_PTR = CH$ASCIZ ($NML$TEXT ('Node = %+%#A%/%N')) 
                 else FMT_PTR = CH$ASCIZ ($NML$TEXT ('Remote Node = %M (%#A)%/%N'));
            end;

        [LINE_]:
            FMT_PTR = CH$ASCIZ ($NML$TEXT ('Line = %+%#A%/%N'));

        [LOGGING_]:
            begin
            EID_PTR = .LOGGING_EIDS [ch$rchar (.EID_PTR) - 1];
            EID_LEN = ch$len (.EID_PTR);
            FMT_PTR = CH$ASCIZ ($NML$TEXT ('Logging = %+%#A%/%N'));
            end;

        [CIRCUIT_]:
            FMT_PTR = CH$ASCIZ ($NML$TEXT ('Circuit = %+%#A%/%N'));

        [MODULE_]:
            FMT_PTR = CH$ASCIZ ($NML$TEXT ('Module = %+%#A%/%N'));
        tes;

    !
    ! Output entity line
    !

    if ((.COMMAND eql CHANGE_) or
	(.COMMAND eql ZERO_))
    then $RSP_TEXT ('%/  %N')		! Format for SET command
    else $RSP_TEXT ('%/%/%N');		! Format for SHOW command

    $RSP_TEXT ((.FMT_PTR),
               .NOD_ADR,
               .EID_LEN,
               .EID_PTR);

    if ((.COMMAND eql CHANGE_) or
	(.COMMAND eql ZERO_))
    then $RSP_TEXT ('%/%N');		! Format for SET command

    return $TRUE;
    end;				! End of FMT_ENTITY_HEADER
%routine ('GET_ERR_MESSAGE', ERR_LEN, ERR_PTR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Determines if the error message field of the NICE response message
!       exists and if so provides its length and a character pointer to it. 
!
! FORMAL PARAMETERS
!
!	ERR_LEN - The address of a variable to contain the length of the
!                 error message.
!
!       ERR_PTR - The address of a variable to contain a pointer to the
!                 error message text.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
!
!	TRUE, If error message exists. FALSE, otherwise.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    begin

    if NEXTF_RESP                       ! Is there an error message field ?
    then begin                          ! Yes...
         .ERR_LEN = GETB (RESP_PTR);    ! Get the message text length
         if ..ERR_LEN gtr 0             ! Is there any text there ?
         then begin                     ! Yes...
              .ERR_PTR = .RESP_PTR;     ! Get pointer to text
              RESP_PTR = ch$plus (.RESP_PTR,..ERR_LEN);  ! And bump past field
              return $TRUE;             ! Indicate error message present
              end;
         end;

    return $FALSE;                      ! Field not in message or no text
    end;				! End of GET_ERR_MESSAGE
%routine ('GET_ENTITY_ID', NODE_NO, EID_LEN, EID_PTR, ENTITY_TYPE) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Obtains a pointer to the entity id if one is present in the NICE
!       response message. If the entity type is node also stores the
!       node address in a variable whose address is provided as a parameter.
!
! FORMAL PARAMETERS
!
!	NODE_NO     - The address of a variable to contain the node address
!                     if the entity type is node.
!
!	EID_LEN     - The address of a variable to contain the length of the
!                     entity id string.
!
!       EID_PTR     - The address of a variable to contain the pointer to the
!                     entity id string.
!
!       ENTITY_TYPE - A value which represents the entity type to which the
!                     the entity id is associated.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
!
!	TRUE, if the response message contains an entity id field.
!       FALSE, otherwise.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    begin

    !
    ! Special case for length byte in node name: bit 7 means executor!
    !

    macro
        NEXTF_NODE (MAX, CNT, PTR) =
            begin
            local TEMP;

            if MAX geq (TEMP = .CNT + 1)
            then begin
                 CNT = .TEMP + (ch$rchar (PTR) and %O'177');
                 (1 eql 1)
                 end
            else (1 eql 0)
            end %;

    macro
        NEXTF_NODE_RESP =
            NEXTF_NODE (.RESP_LEN, RESP_POS, .RESP_PTR) %;

    case .ENTITY_TYPE from NODE_E to MODULE_ of
        set
        [NODE_E]:
            begin
            if NEXTW_RESP               ! Is the node address present?
            then begin                  ! Yes...
                 .NODE_NO = GETW (RESP_PTR); ! Get the node address value
                 if NEXTF_NODE_RESP     ! Is the node name present?
                 then begin             ! Yes...
                      local PTR;

                      .EID_LEN = GETB (RESP_PTR); ! Get length of node name
                      if ..EID_LEN gtr 0
                      then begin
                           PTR = .RESP_PTR; ! Save pointer to node name
                           RESP_PTR = ch$plus (.RESP_PTR, ! Bump past it
                                               ..EID_LEN and %O'177');
                           .EID_PTR = .PTR; ! Return the pointer to node name
                           end
                      else .EID_PTR = 0;
                      end
                 else begin
                      .EID_LEN = 0;
                      .EID_PTR = 0;
                      end;

                 return $TRUE;
                 end
            else begin
                 .NODE_NO = -1;
                 .EID_LEN = 0;
                 .EID_PTR = 0;

                 return $FALSE ;
                 end;
            end;

        [LINE_,
         CIRCUIT_,
         MODULE_]:
            begin
            if NEXTF_RESP               ! Is the id string present?
            then begin                  ! Yes...
                 local PTR;

                 .EID_LEN = GETB (RESP_PTR); ! Get length of id string
                 if ..EID_LEN gtr 0
                 then begin
                      PTR = .RESP_PTR;  ! Save pointer to id string
                      RESP_PTR = ch$plus (.RESP_PTR, ! Bump past it
                                          ..EID_LEN);
                      .EID_PTR = .PTR;  ! Return the pointer to id string
                      end
                 else .EID_PTR = 0;

                 return $TRUE;
                 end
            else begin
                 .EID_LEN = 0;
                 .EID_PTR = 0;

                 return $FALSE ;
                 end;
            end;

        [LOGGING_]:
            begin
            if NEXTB_RESP               ! Is the logging id byte present?
            then begin                  ! Yes...
                 .EID_PTR = .RESP_PTR;  ! Set pointer to logging id
                 .EID_LEN = 1;          ! and set length non-zero.
                 GETB (RESP_PTR);       ! bypass the id.

                 return $TRUE;
                 end
            else begin
                 .EID_LEN = 0;
                 .EID_PTR = 0;

                 return $FALSE;
                 end;
            end;
        tes;

    end;				! End of GET_ENTITY_ID
%routine ('GET_LINK_ERR_TEXT', ERR_DETAIL) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Determines if the error message field of the NICE response message
!       exists and if so provides its length and a character pointer to it. 
!
! FORMAL PARAMETERS
!
!	ERR_LEN - The address of a variable to contain the length of the
!                 error message.
!
!       ERR_PTR - The address of a variable to contain a pointer to the
!                 error message text.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
!
!	TRUE, If error message exists. FALSE, otherwise.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    begin

    case .ERR_DETAIL from 0 to 16 of
        set
        $NICE$ERR_CASES ($LINK_DETAIL_ERRORS);

        [inrange,
         outrange]: 0;
        tes

    end;				! End of GET_LINK_ERR_TEXT
%routine ('GET_FILE_ERR_TEXT', ERR_DETAIL) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Determines if the error message field of the NICE response message
!       exists and if so provides its length and a character pointer to it. 
!
! FORMAL PARAMETERS
!
!	ERR_LEN - The address of a variable to contain the length of the
!                 error message.
!
!       ERR_PTR - The address of a variable to contain a pointer to the
!                 error message text.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
!
!	TRUE, If error message exists. FALSE, otherwise.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    begin

    case .ERR_DETAIL from 0 to 6 of
        set
        $NICE$ERR_CASES ($FILE_DETAIL_ERRORS);

        [inrange,
         outrange]: 0;
        tes

    end;				! End of GET_FILE_ERR_TEXT
%routine ('FMT_RESPONSE_DATA', ENTITY_TYPE, CMD_CODE, REQ) =

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

    begin
            
    local
         DATA_ID: block [1] field (DATA_ID_FIELDS);

    map
       REQ: ref REQUEST_BLOCK;          ! Make fields addressable

    REQ[RB_RESPONSE_DATA] = 1;          ! Set flag non-zero
    if NEXTW_RESP                       ! Any data following return code ?
    then begin                          ! Yes
         local PARAMETER, NEXT;

         PARAMETER = NEXT = -1;         ! Initialize parameter numbers

         do begin
            DATA_ID = GETW (RESP_PTR);  ! Get the data id of this data entry
            NEXT = .DATA_ID[DI_PARMNO]; ! Get parameter number

            if .DATA_ID[DI_TYPE] eql 1
            then begin                  ! Counter field
                 if .DATA_ID[DI_WIDTH] neq 0
                 then FMT_COUNTER (.ENTITY_TYPE, .DATA_ID)
                 else $INTERNAL_ERROR$ ('Invalid counter width in data id');
                 end
            else begin                  ! Parameter field
                 if (.DATA_ID[DI_WIDTH] eql 0)
                 and (.DATA_ID[DI_MAPPED] eql 0)
                 then FMT_PARAMETER (.ENTITY_TYPE,
                                     .DATA_ID,
                                     .NEXT eql .PARAMETER)
                 else $INTERNAL_ERROR$ ('Non-zero reserved fields in data id');
                 end;

            PARAMETER = .NEXT;          ! Remember current parameter number
            end
         while NEXTW_RESP;
         end
    else begin                          ! No
         if (.CMD_CODE eql READ_)       ! Function is READ
         then $RSP_TEXT ($NML$TEXT ('%/  No Information%/')); ! then that's it.
         end;

    !
    ! Terminate the text string with a null byte.
    !

    $RSP_TEXT ('');                    ! Terminate with null

    return $TRUE;
    end;				! End of FMT_RESPONSE_DATA
%routine ('FMT_COUNTER', ENTITY_TYPE, DATA_ID) =

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

    begin
            
    map
       DATA_ID: block [1] field (DATA_ID_FIELDS); ! Data ID byte

    local
         CNTR_NO,                       ! Counter type number
         BITMAP,                        ! Counter bit map
         VALUE,                         ! Counter value
         MAX_VALUE;                     ! Maximum counter value

    CNTR_NO = .DATA_ID[DI_CNTRNO];      ! Get counter number
    BITMAP = 0;
    VALUE = 0;
    MAX_VALUE = 0;

    if .DATA_ID[DI_MAPPED]              ! If mapped counter 
    then begin
         if NEXTW_RESP
         then BITMAP = GETW (RESP_PTR); ! get the bit map
!	 else error
         end;

    case .DATA_ID[DI_WIDTH] from 1 to 3 of
        set
        [1]:                            ! 8 bit counter
            if NEXTB_RESP
            then begin
                 VALUE = GETB (RESP_PTR);
                 MAX_VALUE = (1^8) - 2;
                 end;

        [2]:                            ! 16 bit counter
            if NEXTW_RESP
            then begin
                 VALUE = GETW (RESP_PTR);
                 MAX_VALUE = (1^16) - 2;
                 end;

        [3]:                            ! 32 bit counter
            begin
            NEXTW_RESP;                 ! Account for first two bytes
            if NEXTW_RESP               ! And second two bytes
            then begin
                 VALUE = GETN (RESP_PTR,4);
                 MAX_VALUE = (1^32) - 2;
                 end;
            end;

        [outrange]:                     ! reserved
            $INTERNAL_ERROR$ ('Invalid bit counter width');
        tes;

    INTERPRET_COUNTER (.ENTITY_TYPE, .CNTR_NO, .BITMAP, .VALUE, .MAX_VALUE)

    end;				! End of FMT_COUNTER
%routine ('INTERPRET_COUNTER', ENTITY_TYPE, CNTR_NO, BITMAP, VALUE, MAX_VALUE) =

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

    begin

    local
         CNTR_TEXT_PTR;                 ! Pointer to text of counter name

!
! Get text string for counter (or 0 if counter not found);
!

    CNTR_TEXT_PTR = NCP$COUNTER_TEXT (.ENTITY_TYPE, .CNTR_NO);

!
! Format a text line for the counter
!

    $RSP_TEXT ((if .VALUE leq .MAX_VALUE ! Format unknown counter
                then (if .CNTR_TEXT_PTR eql 0
                      then CH$ASCIZ ($NML$TEXT ('%/  %D%16T%+Counter #%D%N'))
                      else CH$ASCIZ ('%/  %D%16T%A%N'))
                else (if .CNTR_TEXT_PTR eql 0
                      then CH$ASCIZ ($NML$TEXT ('%/ >%D%16T%+Counter #%D%N'))
                      else CH$ASCIZ ('%/ >%D%16T%A%N'))),
               min (.VALUE,.MAX_VALUE),
               .CNTR_TEXT_PTR,
               .CNTR_NO);

!
! Now, if there is a bit map, format a text line for each bit
!

    if .BITMAP nequ 0
    then begin
         $RSP_TEXT (CH$ASCIZ ($NML$TEXT (', including:%N')));
         incr B from 0 to %bpval-1
         do begin
            if .BITMAP
            then begin
                 CNTR_TEXT_PTR = NCP$BIT_TEXT(.ENTITY_TYPE,.CNTR_NO,.B);
                 $RSP_TEXT ((if .CNTR_TEXT_PTR eqlu 0
                             then CH$ASCIZ ($NML$TEXT ('%/%28T%+Bit #%D%N'))
                             else CH$ASCIZ ('%/%28T%A%N')),
                            .CNTR_TEXT_PTR,
                            .B);
                 end;

            BITMAP = .BITMAP ^ -1;
            if .BITMAP eqlu 0
            then exitloop;
            end;
         end;

    return .TEXT_LENGTH;
    end;				! End of INTERPRET_COUNTER
%routine ('FMT_PARAMETER', ENTITY_TYPE, DATA_ID, CONTINUE) : novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Formats the text for a single parameter returned in the
!       data portion of a NICE response message.
!
! FORMAL PARAMETERS
!
!	ENTITY_TYPE - The entity type value to which the parameter is
!                     associated.
!	DATA_ID     - The DATA ID value which precedes the parameter.
!       CONTINUE    - Indicate if this parameter is identical to a previous
!                     one. If this value is true, the parameter name text
!                     is not printed and only the values are displayed.
!
! IMPLICIT INPUTS
!
!	REQ - Address of the Request Block, which contains among other
!             things, a pointer to the NICE response message being
!             processed. The pointer must point at the DATA TYPE byte
!             for this parameter.
!
! ROUTINE VALUE:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    begin
            
    map
       DATA_ID: block [1] field (DATA_ID_FIELDS); ! Data ID byte

    local
         PARAMETER,                     ! Parameter type number
         DATA_TYPE: block [1] field (DATA_TYPE_FIELDS);

    PARAMETER = .DATA_ID[DI_PARMNO];    ! Get the parameter number

    ! If the parameter number is identical to a previous one,
    ! display ", " on the same output line;
    ! otherwise lookup parameter number and output parameter name text string.
    ! If parameter lookup fails display decimal value of parameter number.

    if .CONTINUE
    then $RSP_TEXT (', %N')
    else begin
         local FORMAT, LEXICAL;

         LEXICAL = NML$PARAMETER_TEXT (.ENTITY_TYPE, .PARAMETER);
         if .LEXICAL eql 0              ! No name text for parameter
         then FORMAT = CH$ASCIZ ($NML$TEXT ('%/%2+  Parameter #%D = %N'))
         else begin
              local ENTRY: ref NICE_PARAMETER_TABLE_ENTRY,
                    PARAMETER: ref PARAMETER_ENTRY;

              ENTRY = NML$PARAMETER_LOOKUP (.ENTITY_TYPE, .PARAMETER);
              PARAMETER = .ENTRY[NICE_PARAMETER_ENTRY]; ! Get data base

              if .PARAMETER[_QUALIFIER] ! Is the parameter a qualifier ?
              then FORMAT = CH$ASCIZ ('%2/  %#A = %N') ! Yes
              else FORMAT = CH$ASCIZ ('%/  %#A = %N'); ! No
              end;

         $RSP_TEXT ((.FORMAT),
                    ch$rchar_a (LEXICAL),
                    .LEXICAL,
                    .PARAMETER);
         end;

    if NEXTB_RESP
    then DATA_TYPE = GETB (RESP_PTR);   ! Get the data type bit map byte

    if .DATA_TYPE[DT_CODED] eql 0       ! Uncoded fields
    then FMT_UNCODED_FIELD (.ENTITY_TYPE, .PARAMETER, .DATA_TYPE)
    else begin                          ! Coded fields
         if .DATA_TYPE[DT_FIELDS] eql 0 ! Single field
         then FMT_SINGLE_CODED_FIELD (.ENTITY_TYPE, .PARAMETER, .DATA_TYPE)
         else begin                     ! Multiple fields
              local PREFIX, SUFFIX, FIELD_LENGTH;

              PREFIX = 0;               ! Initially, no prefix string
              SUFFIX = 0;               ! nor suffix string
              FIELD_LENGTH = .DATA_TYPE[DT_NUMBER]; ! Get number of fields

              decr FIELD_LENGTH from .FIELD_LENGTH to 1
              do begin                  ! Loop for each field
                 if .PREFIX neq 0       ! Output the prefix separator string
                 then $RSP_TEXT ((.PREFIX));

                 if NEXTB_RESP          ! Get the data type byte
                 then DATA_TYPE = GETB (RESP_PTR);

                 if .DATA_TYPE[DT_CODED] eql 1 ! Coded field ?
                 then begin
                      if .DATA_TYPE[DT_FIELDS] eql 0 ! Single field ?
                      then FMT_SINGLE_CODED_FIELD (.ENTITY_TYPE,
                                                   .PARAMETER,
                                                   .DATA_TYPE)
                      else begin
                           $INTERNAL_ERROR$ ('Invalid Parameter format, ',
                                             'DATA TYPE contains multip',
                                             'le fields within a multip',
                                             'le field');
                           end;
                      end
                 else FMT_UNCODED_FIELD (.ENTITY_TYPE, .PARAMETER, .DATA_TYPE);

                 if .SUFFIX neq 0
                 then $RSP_TEXT ((.SUFFIX));

                 PREFIX = CH$ASCIZ (' / %N');  ! Default separator

                 selectone .ENTITY_TYPE of
                     set                ! Special prefix and suffix for ....
                     [NODE_E]:          ! EXECUTOR NODE entity
                         begin
                         selectone .PARAMETER of
                             set
                             [140]:     ! NODE parameter
                                 begin
                                 PREFIX = CH$ASCIZ (' (%N');
                                 SUFFIX = CH$ASCIZ (')%N');
                                 end;

                             [101,      ! MANAGEMENT VERSION parameter
                              700,      ! NSP VERSION parameter
                              900]:     ! ROUTING VERSION parameter
                                 PREFIX = CH$ASCIZ ('.%N');

                             [911]:     ! SUBADDRESSES parameter
                                 PREFIX = CH$ASCIZ ('-%N');
                             tes;
                         end;

                     [CIRCUIT_]:        ! CIRCUIT entity
                         begin
                         selectone .PARAMETER of
                             set
                             [200,      ! CONNECTED NODE
                              201,      ! CONNECTED OBJECT
                              800]:     ! ADJACENT NODE
                                 begin
                                 PREFIX = CH$ASCIZ (' (%N');
                                 SUFFIX = CH$ASCIZ (')%N');
                                 end;

                             [otherwise]:
                                 0;
                             tes;
                         end;

                     [MODULE_]:         ! MODULE entity
                         begin
                         selectone .PARAMETER of
                             set
                             [320,      ! NODE parameter
                              340]:     ! OBJECT parameter
                                 begin
                                 PREFIX = CH$ASCIZ (' (%N');
                                 SUFFIX = CH$ASCIZ (')%N');
                                 end;

                             [355,      ! SUBADDRESSES parameter
                              1130]:    ! CHANNELS parameter
                                 PREFIX = CH$ASCIZ ('-%N');
                             tes;
                         end;
                     tes;
                 end;
              end;
         end;

    end;				! End of FMT_PARAMETER
%routine ('FMT_SINGLE_CODED_FIELD', ENTITY_TYPE, PARM_NO, DATA_TYPE) : novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Formats the text output for a single coded parameter value.
!       The text is either the name for a recognized coded value or
!       the octal value itself.
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    begin

    map
       DATA_TYPE: block [1] field (DATA_TYPE_FIELDS);

    local
         FORMAT,                        ! Pointer to text output format
         TEXT,                          ! Pointer to coded name text
         TEXT_LENGTH,                   ! Length of coded name text
         FIELD_LENGTH,                  ! Length of data
         DATA;                          ! Value of coded data

    FIELD_LENGTH = .DATA_TYPE[DT_NUMBER]; ! Get number of bytes
    if NEXTN_RESP (.FIELD_LENGTH)
    then DATA = GETN (RESP_PTR, .FIELD_LENGTH) ! Get coded value
    else $INTERNAL_ERROR$ ('Message short terminated');

    !
    ! Lookup parameter number and output coded text string.
    ! If parameter lookup fails display the code in octal.
    !

    TEXT = NML$CODED_TEXT (.ENTITY_TYPE, .PARM_NO, .DATA);

    if .TEXT eql 0
    then FORMAT = CH$ASCIZ ('%2+%O%N')
    else begin
         FORMAT = CH$ASCIZ ('%#A%N');
         TEXT_LENGTH = ch$rchar_a (TEXT);
         end;

    $RSP_TEXT ((.FORMAT), .TEXT_LENGTH, .TEXT, .DATA);

    end;				! End of FMT_SINGLE_CODED_FIELD
%routine ('FMT_UNCODED_FIELD', ENTITY_TYPE, PARM_NO, DATA_TYPE) : novalue =

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

    begin

    map
       DATA_TYPE: block [1] field (DATA_TYPE_FIELDS);

    local
         FIELD_LENGTH,                  ! Length of data for ASCII or binary
         BINARY_FORMAT,                 ! Format value if binary
         FMT_PTR,                       ! Pointer to text output format
         DATA;                          ! Binary value or pointer to ASCII

    if .DATA_TYPE[DT_FTYPE] eql 1
    then begin                          ! ASCII image field
         if .DATA_TYPE[DT_NUMBER] eql 0
         then begin
              if NEXTF_RESP
              then begin
                   FIELD_LENGTH = GETB (RESP_PTR); ! Get I-field length
                   DATA = .RESP_PTR;    ! Pointer to ASCII text in message
                   RESP_PTR = ch$plus (.RESP_PTR,.FIELD_LENGTH);  
                   $RSP_TEXT ('%#A%N', .FIELD_LENGTH, .DATA);
                   end
              else $INTERNAL_ERROR$ ('Response short terminated')
              end
         else $INTERNAL_ERROR$ ('Non-zero reserved field in data type')
         end
    else begin                          ! Binary number
         FIELD_LENGTH = .DATA_TYPE[DT_LENGTH];
         BINARY_FORMAT = .DATA_TYPE[DT_FORMAT];

         if .FIELD_LENGTH eql 0
         then begin                     ! Image binary field
              if NEXTB_RESP
              then FIELD_LENGTH = GETB (RESP_PTR);

              if .FIELD_LENGTH gtr 0
              then begin
                   if NEXTN_RESP (.FIELD_LENGTH)
                   then begin
                        DATA = .RESP_PTR; ! Save pointer to binary string
                        GETN (RESP_PTR, .FIELD_LENGTH); ! Get data field
                        case .BINARY_FORMAT from 0 to 3 of 
                            set
                            [0]:                  ! Unsigned decimal
                                FMT_PTR = CH$ASCIZ ('%#M%N');

                            [1]:                  ! Signed decimal
                                FMT_PTR = CH$ASCIZ ('%#D%N');

                            [2]:                  ! Hexadecimal
                                FMT_PTR = CH$ASCIZ ('%#K%N');

                            [3]:                  ! Octal
                                FMT_PTR = CH$ASCIZ ('%#O%N');
                            tes;

                        $RSP_TEXT ((.FMT_PTR), .FIELD_LENGTH, .DATA);
                        end;
                   end
              else $RSP_TEXT ('No Information%N');
              end
         else begin                     ! Fixed binary field
              if NEXTN_RESP (.FIELD_LENGTH)
              then begin
                   if .FIELD_LENGTH leq %bpval/8
                   then begin
                        DATA = GETN (RESP_PTR,.FIELD_LENGTH);
                        case .BINARY_FORMAT from 0 to 3 of 
                            set
                            [0]:                  ! Unsigned decimal
                                FMT_PTR = CH$ASCIZ ('%M%N');

                            [1]:                  ! Signed decimal
                                FMT_PTR = CH$ASCIZ ('%D%N');

                            [2]:                  ! Hexadecimal
                                FMT_PTR = CH$ASCIZ ('%H%N');

                            [3]:                  ! Octal
                                FMT_PTR = CH$ASCIZ ('%O%N');
                            tes;

                        $RSP_TEXT ((.FMT_PTR), .DATA);
                        end
                   else begin
			bind NL = 1;
                        RESP_PTR = ch$plus (.RESP_PTR,.FIELD_LENGTH);
                        case .BINARY_FORMAT from 0 to 3 of 
                            set
                            [0]:                  ! Unsigned decimal
                            %( N.B. - There is no way to output a byte string
                               as decimal so fake these for now. )%
                                FMT_PTR = CH$ASCIZ ('%#B %N');

                            [1]:                  ! Signed decimal
                                FMT_PTR = CH$ASCIZ ('%#B %N');

                            [2]:                  ! Hexadecimal
                                FMT_PTR = CH$ASCIZ ('%#K%N');

                            [3]:                  ! Octal
                                FMT_PTR = CH$ASCIZ ('%#B %N');
                            tes;

			incr N from 1 to .FIELD_LENGTH do
			    begin
                            DATA = ch$plus(.RESP_PTR, -.N);
                            $RSP_TEXT ((.FMT_PTR), NL, .DATA);
                            end;
                        end;
                   end
              end
         end

    end;				! End of FMT_UNCODED_FIELD
end                                   ! End of Module NCPRSP
eludom
! Local Modes:
! Mode:BLISS
! Auto Save Mode:2
! Comment Column:40
! Comment Rounding:+1
! End: