Google
 

Trailing-Edge - PDP-10 Archives - BB-P363B-SM_1985 - t20/nmlt20/ncpori.b36
There is 1 other file named ncpori.b36 in the archive. Click here to see a list.
! UPD ID= 305, SNARK:<6.1.NML>NCPORI.B36.5,  29-Apr-85 20:02:20 by GLINDELL
!  Add MFLAGS and AFLAGS arguments to PROCESS_MESSAGE.  In NCP$SEND_RESPONSE,
!  set flag WT.NFO in the call to PROCESS_MESSAGE - this will left justify
!  all NCP output.  Also add argument FORMAT_FLAG to NCP$SEND_RESPONSE so
!  caller can determine whether left justification should be done or not
!
! UPD ID= 200, SNARK:<6.1.NML>NCPORI.B36.4,  10-Dec-84 15:17:49 by HALPIN
! Get MONSYM Library file out of default directory, not BLI:
!
! UPD ID= 82, SLICE:<6.1.NML>NCPORI.B36.3,  18-Sep-84 14:55:32 by GUNN
! WORK:<GUNN.NML>NCPORI.B36.2 21-Aug-84 12:01:57, Edit by GUNN
!
! Change to accomodate new LIBRARY conventions. MONSYM.L36 and JLNKG.L36
! are now explicity declared here rather than in NMULIB.
!
! UPD ID= 56, SNARK:<6.1.NML>NCPORI.B36.2,  14-Jun-84 09:56:15 by GLINDELL
! Undeclare conditionals like Jim did in NCPCEX
!
! PH4:<PECKHAM>NCPORI.B36.2 20-May-83 23:26:41, Edit by PECKHAM
!
! Ident 14.
! Add NCP$TEST_RESPONSE, which will help NCPRSP determine if a new
! buffer is to be started in order to insert a header for tabular
! responses.
!
! NET:<BRANDT.DEVELOP>NCPORI.B36.4 25-Feb-82 11:19:18, Edit by BRANDT
!
! Ident 13.
! Change the PROCESS_MESSAGE routine to handle multiple OPRs as well
! as simultaneous multiple input streams to the same OPR.
!
! <VOBA.NML.DEVELOPMENT>NCPORI.B36.25 23-Feb-82 09:46:10, Edit by VOBA
!
! Ident 12.
! Fix PROCESS_MESSAGE to handle multiple segment message, and not to
! clobber current data in the buffer.
! 
! NET:<BRANDT.DEVELOP>NCPORI.B36.4 1-Feb-82 11:19:18, Edit by BRANDT
!
! Ident 11.
! Reduce TEXT_BUFFER_SIZE in PROCESS_MESSAGE still further so ORION
! can process large messages.
!
! NET:<BRANDT.DEVELOP>NCPORI.B36.4 20-Jan-82 16:19:18, Edit by BRANDT
!
! Ident 10.
! Reduce TEXT_BUFFER_SIZE in PROCESS_MESSAGE so ORION can process
! large messages.
!
! NET:<BRANDT.DEVELOP>NCPORI.B36.4 18-Jan-82 16:19:18, Edit by BRANDT
!
! Ident 09.
! Fix calculation of LENGTH value in routine PROCESS_MESSAGE to
! prevent messages from being truncated.
!
! NET:<BRANDT.DEVELOPMENT>NCPORI.B36.4 11-Jan-82 15:19:18, Edit by BRANDT
!
! Ident 08.
! 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.
!
! NET:<GUNN.DEVELOPMENT>NCPORI.B36.7  8-Jan-82 17:50:06, Edit by GUNN
!
! Ident 07.
! Remove output of 'OPR does not exist' $OMTXT message.
!
! Update copyright date to 1982.
!
! NET:<DECNET20-V3P1.NCP.SOURCES>NCPORI.B36.4  6-Aug-81 16:37:29, Edit by GUNN
!
! Ident 06.
! Fix spelling of text in a message.
!
! NET:<DECNET20-V3P1.NCP.SOURCES>NCPORI.B36.3 28-Jul-81 16:42:07, Edit by GUNN
!
! Ident 05.
! Fix format string for output of $OMTXT message to print the text in the
! message under all conditions. A %N was missing.
! Change $INTERNAL_ERROR$ macro calls to TASK_ERROR.
!
! NET:<DECNET20-V3P1.NCP.SOURCES>NCPORI.B36.3 19-Jun-81 16:03:34, Edit by GUNN
!
! Ident 04.
! Add code to output contents of unsolicited or invalid IPCF messages
! received.
!
! NET:<DECNET20-V3P1.NCP.SOURCES>NCPORI.B36.4 10-Jun-81 10:39:47, Edit by GUNN
!
! Ident 03.
! Fix some typos from last edit.
! Add support for NMU debugging code.
!
! NET:<DECNET20-V3P1.NCP.SOURCES>NCPORI.B36.3 10-Jun-81 09:36:22, Edit by GUNN
!
! Ident 02.
! Change NCP$ORI_INITIALIZE to retry on failure to get ORION's PID.
!
! NET:<DECNET20-V3P1.BASELEVEL-2.SOURCES>NCPORI.B36.6 13-Feb-81 16:09:59, Edit by GUNN
!
! Update copyright date.
!
%title 'NCPORI -- Operator Interface Services'
module NCPORI	(
		ident = 'X03.14'
		) =
begin

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

!++
! FACILITY:	DECnet-10/20 V3.0 Network Control Program (NCP)
!
! ABSTRACT:
!
!	Provides Operator Interface Services for NCP and NM when
!	running under TOPS-10 and TOPS-20. 
!
! ENVIRONMENT:	TOPS-10/20 User mode under NML
!
! AUTHOR: Dale C. Gunn , CREATION DATE: 21-Aug-80
!
! MODIFIED BY:
!
!	, : VERSION
! 01	-
!--
!
! INCLUDE FILES:
!

library 'NCPLIB';                       ! All required definitions

library 'MONSYM';			! Monitor symbols

library 'JLNKG';			! JSYS linkage definitions

undeclare $TOPS10,$TOPS20,$X25,$MCB;    ! Undeclare these names, because GALAXY
                                        ! gets SYSTYP.REQ also
library 'GALAXY';                       ! GALAXY interface definitions 

require 'NCPEXT';                       ! NCP External Names

!
! TABLE OF CONTENTS
!

forward routine
       NCP$ORI_INITIALIZE,
       NCP$SIGN_ON,
       NCP$GET_COMMAND,
       NCP$LOG_TO_OPERATOR : novalue,
       NCP$SEND_RESPONSE : novalue,
       NCP$SEND_TO_OPERATOR : novalue,
       NCP$TEST_RESPONSE,
       PROCESS_MESSAGE : novalue,
       SEND_MESSAGE : novalue,
       BUILD_MS_HEADER,
       BUILD_MS_ACD,
       BUILD_MS_TXT,
       OPR_ID_MATCH;
!
! MACROS:
!

!
! EQUATED SYMBOLS:
!

%MODULE_NAME ('NCPORI');         ! Declare module to NMU debug facility

literal
    ACD_LENGTH = 2;              ! Length of $WTACD argument block


!
! BPB - Buffer Parameter Block structure definition
!

$field BUFFER_PARAMETER_BLOCK_FIELDS =
    set
    BPB_QLINK = [$sub_block(Q_ENTRY_SIZE)], ! Queue header fields
    BPB_OPR_ID = [$integer],   ! Operator ID (a PID)
    BPB_BUF_ADR = [$address],  ! Address of buffer
    BPB_CUR_PTR = [$pointer],  ! Pointer to current position in buffer
    BPB_BUF_REM = [$integer],  ! Chars of buffer still available
    BPB_SEQ_COUNT = [$integer] ! Count of active message sequences
    tes;

literal
    BUFFER_PARAMETER_BLOCK_SIZE = $field_set_size, ! Size in words
    BUFFER_PARAMETER_BLOCK_ALLOC = BUFFER_PARAMETER_BLOCK_SIZE * %upval;

macro
     BUFFER_PARAMETER_BLOCK =
         block [BUFFER_PARAMETER_BLOCK_SIZE]
	 field (BUFFER_PARAMETER_BLOCK_FIELDS) %;
!
! OWN STORAGE:
!

own
   NCP_PID,                             ! Our PID for communication with ORION
   NCP_COD,                             ! NCP's application code
   ORION_PID,                           ! ORION's system PID
   QH_BUFFERS: Q_HEADER;		! Queue header for message buffers

!
! EXTERNAL REFERENCES:
!

external
    %debug_data_base;                   ! Data base for NMU debugging facility

external routine
    NCP$COMMAND;                        ! NCP Command Processor
%global_routine ('NCP$ORI_INITIALIZE') =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Performs system specific operator interface initialization
!	for TOPS-10/20. Obtains a PID for our use and gets
!       the system wide PID for ORION and stores them. Signs on to
!       ORION, the GALAXY component which acts as the operator
!	interface under TOPS-10/20, as NCP.
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
!
!	 TRUE, if successfully signed on to ORION.
!
! SIDE EFFECTS:
!
!	NCP is successfully signed on to ORION.
!
!--

    begin

    local
         RETRY;                         ! ORION retry counter

    literal
           WARNING_INTERVAL = 2,        ! Time between warning messages (min)
           RETRY_INTERVAL = 5;          ! Time between retries (sec)

    bind
        NCP_NAME = CH$ASCIZ ('NCP');    ! Application name used to sign on to
                                        ! ORION

    NMU$QUEUE_RESET (QH_BUFFERS) ;	! Initialize message buffers

!
! Try to get an IPCF Process ID, using our name and restricted to
! receiving from only PIDs we will allow. If we get a valid PID
! for ourselves, then try to get the PID of ORION.
!

    if (NCP_PID = NMU$IPCF_CREATE (NCP_NAME, $TRUE)) eql 0
    then TASK_ERROR ('Could not create PID for NCP');

    RETRY = 0;                          ! Clear retry counter

    until (ORION_PID = NMU$IPCF_ORION ()) neq 0
    do begin
       !
       ! Failed to get a PID for ORION; hasn't started yet.
       ! Keep trying...
       !
       if (.RETRY/((WARNING_INTERVAL * 60)/RETRY_INTERVAL)) eql 0
       then TASK_INFO ('Waiting for ORION to start');
       RETRY = .RETRY + 1;              ! Bump for this retry
       NMU$SCHED_SLEEP (RETRY_INTERVAL);
       end;

    !
    ! When we have gotten both PIDs successfully, allow receipt
    ! of IPCF packets from ORION only. Then perform the ORION
    ! sign on procedure and return true if successful.
    !

    NMU$IPCF_ALLOW (.NCP_PID, .ORION_PID); ! Receive from ORION only

    if not NCP$SIGN_ON (NCP_NAME)       ! Say hello to ORION, we're NCP
    then TASK_ERROR ('Could not sign on to ORION'); ! Unfriendly BEAST...

    return $TRUE                        ! Successful return

    end;				! End of NCP$ORI_INITIALIZE
%routine ('NCP$SIGN_ON', NAME) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Performs the actions necessary to sign on to ORION as an
!       applications processor. Sends the
!       GALAXY application hello message to ORION and receives the
!       response acknowledgement. Saves the application code returned
!       in the acknowledgement message for later use in sending
!       messages to ORION.
!
! FORMAL PARAMETERS
!
!	NAME    - Optional pointer to 5 character ASCII name to be 
!                 used for our local PID.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
!
!	 TRUE, if ORION sign on is successful.
!
! SIDE EFFECTS:
!
!	A PID is obtained for use by NCP and stored in NCP_PID.
!	The system wide PID for ORION is obtained and stored in ORION_PID.
!	An application hello message is created and sent to ORION.
!	A hello acknowledgement message is received from ORION.
!	The application type code returned in the ACK message is
!	stored for later use in NCP_COD.
!
!--

    begin

    own                                 ! GALAXY Application Hello message
        NCP_HELLO: ALLOCATE_MS (TYPE = $OMAHL,
                                ARGUMENTS = (($AHNAM, ! Default name
                                            (%ascii 'NCP',0))));

    local
         ARG_ADDR: ref ARG_BLOCK (2),   ! Address of argument block
         HELLO_ACK: ref MS_BLOCK (PAGE_SIZE); ! Address of received ACK message

    ! Try to send application hello message to ORION

    NCP_HELLO[CODMS$] = .NCP_PID;       ! Put our PID in code field as id

    if .NAME neq 0                      ! Is name present?
    then begin                          ! Yes, move it to HELLO message
         ARG_ADDR = NCP_HELLO + $OHDRS; ! Get address of argument block
         ch$move (5,                    ! Max of 5 characters
                  .NAME,                ! From pointer supplied
                  ch$ptr(ARG_ADDR[DA$ARG])); ! To the argument block
         end;

    NMU$IPCF_TRANSMIT (.NCP_PID,        ! From NCP
                       .ORION_PID,      ! To ORION
                       NCP_HELLO,       ! An Application Hello for NCP
                       .NCP_HELLO[CNT$MS]); ! Its length

    !
    ! Read acknowledgement message from ORION
    !

    HELLO_ACK = NMU$IPCF_RECEIVE (.NCP_PID); ! Read message from ORION
    NCP_COD = 0;                        ! Clear our application type code

%( N.B. - The current GALAXY version 4 is documented as returning
          our PID in the CODMS. field of the IPCF MS message. Due to
          a functional deficiency in ORION version 4 it is not returned
          to us. When the next version of GALAXY comes out this check
          should be made.
)%

    if (.HELLO_ACK[TYP$MS] eqlu $OMHAC) ! Is this a hello ACK ?
!   and .HELLO_ACK[CODMS$] eqlu .NCP_PID ! And from us
    then if (.HELLO_ACK[ARGCO$] gequ 1) ! If so,is there at least 1 argument ?
         and (.HELLO_ACK[CNT$MS] gequ ($OHDRS + 2)) ! & is it long enough ?
         then begin                     ! First argument should be .AHTYP
              local ARG: ref ARG_BLOCK ();

              ARG = .HELLO_ACK + $OHDRS; ! Get address of first argument
              if (.ARG[TYP$AR] eqlu $AHTYP) and (.ARG[LEN$AR] gequ 2)
              then begin
                   NCP_COD = .ARG[DA$ARG]; ! Save our application type code
                   NMU$PAGE_RELEASE ((.HELLO_ACK/PAGE_SIZE)); ! Release memory
                   end
              else TASK_ERROR ('First argument in MS block not an application type code')
              end
         else TASK_ERROR ('MS block contains no arguments or too short')
    else begin
         if (.HELLO_ACK[TYP$MS] eqlu $OMTXT) ! Or is it error text ?
!        and .HELLO_ACK[CODMS$] eqlu .NCP_PID ! And from us
         then if (.HELLO_ACK[ARGCO$] gequ 1) ! at least 1 argument ?
              and (.HELLO_ACK[CNT$MS] gequ ($OHDRS + 2)) ! long enough ?
              then begin                ! First argument should be .CMTXT
                   local ARG: ref ARG_BLOCK ();

                   ARG = .HELLO_ACK + $OHDRS;  ! Get address of first argument
                   if (.ARG[TYP$AR] eqlu $CMTXT) and (.ARG[LEN$AR] gequ 2)
%( N.B. - This should be TASK_ERROR and it should print message saying task
          halted. )%
                   then TASK_INFO (ch$ptr(ARG[DA$ARG])) ! Print ORION error
                   else TASK_ERROR ('First argument in MS not text')
                   end
              else TASK_ERROR ('MS block contains no arguments or too short')
         else TASK_ERROR ('MS block is neither an application hello ACK or error text message')
         end;

    return $TRUE

    end;				! End of NCP$SIGN_ON
%global_routine ('NCP$GET_COMMAND') =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Reads the next available IPCF message for NCP. Checks the
!       MS.TYPE field of the received message. If the field contains
!       the value .OMCMD, indicating an Application Command message,
!       then NCP$COMMAND is called, with the address of the message,
!       to perform command processing, otherwise special processing
!       is done based on the MS.TYP field. 
!
! FORMAL PARAMETERS
!
!	NONE.
!
! IMPLICIT INPUTS
!
!	NCP_PID contains the PID on which the IPCF receive is done.
!
! ROUTINE VALUE:
!
!	 The address of an OPR/ORION Application Command message.
!
! SIDE EFFECTS:
!
!	ORION message types .OMRSP, .OMACK, and .OMHAC receive special
!       processing. Any others are considered errors and cause error
!       messages to be issued.
!
!--

    begin

    local
         MS: ref MS_BLOCK (PAGE_SIZE),  ! Address of received MS block
         COM: ref COM_BLOCK (PAGE_SIZE); ! Address of COM block

    literal
           TXT_BFR_LENGTH = 160,
           TXT_BFR_SIZE = ch$allocation (TXT_BFR_LENGTH),
           TXT_BFR_ALLOCATION = TXT_BFR_SIZE * %upval;

    MS = NMU$IPCF_RECEIVE (.NCP_PID);   ! Get a message
    COM = .MS + $OHDRS;                 ! Get address of COM block

    selectoneu .MS[TYP$MS] of
        set
        [$OMCMD] :                      ! Command Message
            NCP$COMMAND (.MS);          ! Process it

        [$OMTXT]:                       ! Text message
            begin                       !   probably our error
            local
                TXT_BFR,                ! Address of buffer for text
                TXT_PTR,                ! Pointer to text string
                TXT_LEN,                ! Length of text message
                TEMP,
                ARG: ref ARG_BLOCK ();  ! Structure for argument block

%( N.B. - We can get an 'ODE' text message in the case where the user has
          reset his OPR before some or all of the command response IPCF
          packets have been sent.
          In this case we probably want to call some routine to remove
          the entry for this OPR's PID from the executor queue, to
          keep it as clean as possible.)%

            TEMP<18,18> = .MS[SUF$MF];
            if .TEMP neq %sixbit'ODE'   ! Don't output
                                        ! 'OPR does not exist' message.
            then begin
                 TXT_BFR = NMU$MEMORY_GET (TXT_BFR_ALLOCATION);
                 TXT_PTR = ch$ptr (.TXT_BFR);
                 TXT_LEN = 0;

                 TXT_LEN = $NMU$TEXT (TXT_PTR,
                                      TXT_BFR_LENGTH,
                                      'Received $OMTXT message from ORION %N');

                 if .MS[CODMS$] neq .NCP_PID ! Is it our message?
                 then begin
                      TEMP = .MS[CODMS$];
                      TXT_LEN = $NMU$TEXT (TXT_PTR,
                                           TXT_BFR_LENGTH - .TXT_LEN,
                                           ', Message PID = %O,,%O %N',
                                           .TEMP<18,18>,
                                           .TEMP<0,18>);
                      end;

                 if (.MS[ARGCO$] gequ 1) ! at least 1 argument ?
                 and (.MS[CNT$MS] gequ ($OHDRS + 2)) ! long enough ?
                 then begin             ! First argument should be .CMTXT
                      ARG = .MS + $OHDRS;  ! Get address of first arg
                      if (.ARG[TYP$AR] eqlu $CMTXT) and (.ARG[LEN$AR] gequ 2)
                      then begin
                           $NMU$TEXT (TXT_PTR,
                                      TXT_BFR_LENGTH - .TXT_LEN,
                                      ' - %A',
                                      ch$ptr(ARG[DA$ARG])) ! Print ORION text
                           end
                      else $NMU$TEXT (TXT_PTR,
                                      TXT_BFR_LENGTH - .TXT_LEN,
                                      ' - <Text Block Missing: AR.TYP = %O, AR.LEN = %O>',
                                      .ARG[TYP$AR],.ARG[LEN$AR])
                      end
                 else $NMU$TEXT (TXT_PTR,
                                 TXT_BFR_LENGTH - .TXT_LEN,
                                 ' - <Message contains no arguments or too short>');

                 TASK_INFO (ch$ptr(.TXT_BFR));
                 NMU$MEMORY_RELEASE (.TXT_BFR,TXT_BFR_ALLOCATION);
                 end;
            end;

        [$OMRSP] :                      ! Response to WTOR
            begin                       ! Process response to WTOR, maybe not used
            TASK_INFO ('Received WTOR response, WTOR not used');
            end;

        [$OMACK] :                      ! Acknowledgement
            begin                       ! Process ACK, maybe not used
            TASK_INFO ('Received ACK, acknowledgements not requested');
            end;

        [$OMHAC] :                      ! ACK to HELLO
            begin
            TASK_INFO ('Received ACK to application hello after succesful sign-on');
            end;

        [otherwise]:                    ! Ones we should not see
            begin
            local
                TXT_BFR,                ! Address of buffer for text
                TXT_PTR,                ! Pointer to text string
                TXT_LEN,                ! Length of text message
                ARG: ref ARG_BLOCK ();  ! Structure for argument block

            TXT_BFR = NMU$MEMORY_GET (TXT_BFR_ALLOCATION);
            TXT_PTR = ch$ptr (.TXT_BFR);
            TXT_LEN = 0;

            TXT_LEN = $NMU$TEXT (TXT_PTR,
                                 TXT_BFR_LENGTH,
                                 'Received invalid message type from ORION: TYPE = %O PID = %O',
                                 .MS[TYP$MS],
                                 .MS[CODMS$]);

            TASK_INFO (ch$ptr(.TXT_BFR));
            NMU$MEMORY_RELEASE (.TXT_BFR,TXT_BFR_ALLOCATION);
            end;
        tes;

    NMU$PAGE_RELEASE (.MS/PAGE_SIZE);   ! Release memory for IPCF message

    return $TRUE

    end;				! End of NCP$GET_COMMAND
%global_routine ('NCP$LOG_TO_OPERATOR', MORE, POINTER) : novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Sends an arbitrary text message to the system operators log
!       file.
!
! FORMAL PARAMETERS
!
!
!	MORE    - A flag to indicate if this is a single or multipart message
!		  0 -- this is a single message
!		  1 -- this begins a multipart message sequence
!		  2 -- this is part of a multipart message sequence
!		  3 -- this terminates a multipart message sequence
!
!	POINTER - A character sequence pointer to the text to be logged.
!
!
! IMPLICIT INPUTS
!
!	NCP_COD   - Contains the GALAXY application code for NCP.
!       ORION_PID - The destination PID.
!       NCP_PID   - The source PID.
!
! ROUTINE VALUE:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	An ORION LOG message is sent.
!
!--

    begin

    PROCESS_MESSAGE (.MORE, .POINTER, .NCP_PID, $OMLOG, 0, 0);

    end;				! End of NCP$LOG_TO_OPERATOR
%global_routine ('NCP$SEND_RESPONSE', MORE, POINTER, ID, FORMAT_FLAG)
                             : novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Sends an arbitrary text message to a specified operator.
!
! FORMAL PARAMETERS
!
!	MORE    - A flag to indicate if this is a single or multipart message
!		  0 -- this is a single message
!		  1 -- this begins a multipart message sequence
!		  2 -- this is part of a multipart message sequence
!		  3 -- this terminates a multipart message sequence
!
!	POINTER - A character sequence pointer to the text to be logged.
!
!	ID      - A value which will be used as the operator's ID
!		  to which this repsonse will be returned.
!
!       FORMAT_FLAG - non-zero if response should be left-justified
!
! IMPLICIT INPUTS
!
!	NCP_COD   - Contains the GALAXY application code for NCP.
!       ORION_PID - The destination PID.
!       NCP_PID   - The source PID.
!
! ROUTINE VALUE:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	An ORION ACK message is sent.
!
!--

    begin

    PROCESS_MESSAGE (.MORE,
                     .POINTER,
                     .ID,
                     $OMACK,
                     0,
                     (if .FORMAT_FLAG then WT$NFO else 0));

    end;				! End of NCP$SEND_RESPONSE
%global_routine ('NCP$SEND_TO_OPERATOR', MORE, POINTER) : novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Sends an arbitrary text message to the operator.
!
! FORMAL PARAMETERS
!
!	MORE    - A flag to indicate if this is a single or multipart message
!		  0 -- this is a single message
!		  1 -- this begins a multipart message sequence
!		  2 -- this is part of a multipart message sequence
!		  3 -- this terminates a multipart message sequence
!
!	POINTER - A character sequence pointer to the text to be logged.
!
! IMPLICIT INPUTS
!
!	NCP_COD   - Contains the GALAXY application code for NCP.
!       ORION_PID - The destination PID.
!       NCP_PID   - The source PID.
!
! ROUTINE VALUE:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	An ORION WTO message is sent.
!
!--

    begin

    PROCESS_MESSAGE (.MORE, .POINTER, .NCP_PID, $OMWTO, 0, 0);

    end;				! End of NCP$SEND_TO_OPERATOR
%global_routine ('NCP$TEST_RESPONSE', MORE, POINTER, ID) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Sends an arbitrary text message to a specified operator.
!
! FORMAL PARAMETERS
!
!	MORE    - A flag to indicate if this is a single or multipart message
!		  0 -- this is a single message
!		  1 -- this begins a multipart message sequence
!		  2 -- this is part of a multipart message sequence
!		  3 -- this terminates a multipart message sequence
!
!	POINTER - A character sequence pointer to the text to be logged.
!
!	ID      - A value which will be used as the operator's ID
!		  to which this repsonse will be returned.
!
! IMPLICIT INPUTS
!
!	NCP_COD   - Contains the GALAXY application code for NCP.
!       ORION_PID - The destination PID.
!       NCP_PID   - The source PID.
!
! ROUTINE VALUE:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    begin

    local
	LENGTH,
	BUFFER_PB: ref BUFFER_PARAMETER_BLOCK;

!
! Maximum text buffer size for WTO message is WTOMAX (defined in ORNMAC)
! minus the space required for headers. (message header, application
! code block, and text block header word)
! (minus a few more, since ORION seems to have problems if maximum text
!  messages are sent.)
!
    literal
	TEXT_BUFFER_SIZE = (WTOMAX-$OHDRS-ACD_LENGTH-50)*(%BPVAL/CH$SIZE());

!
!   See  if  we already have a current buffer for this OPR.  If not,
!   message will not fit.
!
    BUFFER_PB = NMU$QUEUE_SCAN (QH_BUFFERS, .ID, OPR_ID_MATCH);
    if .BUFFER_PB eql 0 then return $false;
!
!   Get the length of this message.  If this message will not fit in
!   the  current buffer or if we already have text in the buffer and
!   this    message starts a new sequence,  then indicate no fit.
!
    LENGTH = CH$LEN (.POINTER, (TEXT_BUFFER_SIZE - 1));

    if ((.BUFFER_PB[BPB_BUF_REM] - .LENGTH) lss 1) or
       ((.BUFFER_PB[BPB_BUF_REM] neq TEXT_BUFFER_SIZE) and
        ((.MORE eql 0) or (.MORE eql 1)))
    then return $false;
!
! The message will fit
!
    $true
    end;				! End of NCP$TEST_RESPONSE
%routine ('PROCESS_MESSAGE', MORE, POINTER, ID, TYPE, MFLAGS, AFLAGS)
                     : novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!   This routine receives a message, transfers it to an intermediate
!   buffer, and manages the eventual transmission of that buffer  to
!   GALAXY.   A  message  this  routine  processes might be a single
!   message or part of a message sequence.  This routine  will  copy
!   all  messages  to an intermediate buffer and then transfer that
!   buffer to GALAXY when appropriate.  Since it is also possible to
!   have  incoming  messages  for  different OPRs, different buffers
!   must be maintained.
!
! FORMAL PARAMETERS
!
!	MORE    - A flag to indicate if this is a single
!		   or multipart message
!		  0 -- this is a single message
!		  1 -- this begins a multipart message sequence
!		  2 -- this is part of a multipart message sequence
!		  3 -- this terminates a multipart message sequence
!
!	POINTER - A character sequence pointer to the message text
!
!	ID      - A value which will be used as the operator's ID
!                 to which this repsonse will be returned.
!
!	TYPE    - A value which represents the GALAXY message type
!                 to be built.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--
    begin

    local
	LENGTH,
	BUFFER_PB: ref BUFFER_PARAMETER_BLOCK;

!
! Maximum text buffer size for WTO message is WTOMAX (defined in ORNMAC)
! minus the space required for headers. (message header, application
! code block, and text block header word)
! (minus a few more, since ORION seems to have problems if maximum text
!  messages are sent.)
!
    literal
	TEXT_BUFFER_SIZE = (WTOMAX-$OHDRS-ACD_LENGTH-50)*(%BPVAL/CH$SIZE());

!
!   See  if  we already have a current buffer for this OPR.  If not,
!   set one up.
!
    BUFFER_PB = NMU$QUEUE_SCAN (QH_BUFFERS, .ID, OPR_ID_MATCH);
    if .BUFFER_PB eql 0
    then
	begin
	BUFFER_PB = NMU$MEMORY_GET (BUFFER_PARAMETER_BLOCK_ALLOC);
 	BUFFER_PB[BPB_OPR_ID] = .ID;
 	BUFFER_PB[BPB_BUF_ADR] = (NMU$PAGE_GET () * PAGE_SIZE);
 	BUFFER_PB[BPB_CUR_PTR] = ch$ptr (.BUFFER_PB[BPB_BUF_ADR]);
 	BUFFER_PB[BPB_BUF_REM] = TEXT_BUFFER_SIZE;
 	BUFFER_PB[BPB_SEQ_COUNT] = 0;
	NMU$QUEUE_INSERT (QH_BUFFERS, .BUFFER_PB);
	end;
!
!   Get the length of this message.  If this message will not fit in
!   the  current buffer or if we already have text in the buffer and
!   this    message starts a new sequence,  then  send  the  current
!   buffer, and reset the buffer parameters to indicate it is empty.
!
    LENGTH = CH$LEN (.POINTER, (TEXT_BUFFER_SIZE - 1));

    if ((.BUFFER_PB[BPB_BUF_REM] - .LENGTH) lss 1) or
       ((.BUFFER_PB[BPB_BUF_REM] neq TEXT_BUFFER_SIZE) and
        ((.MORE eql 0) or (.MORE eql 1)))
    then begin
         ch$wchar (%O'0', .BUFFER_PB[BPB_CUR_PTR]);
         SEND_MESSAGE (.TYPE,
		       .ID,
		       ch$ptr (.BUFFER_PB[BPB_BUF_ADR]),
                       .MFLAGS,
                       .AFLAGS);
         BUFFER_PB[BPB_CUR_PTR] = ch$ptr (.BUFFER_PB[BPB_BUF_ADR]);
         BUFFER_PB[BPB_BUF_REM] = TEXT_BUFFER_SIZE;
         end;
!
! Move current message to buffer and adjust remaining buffer length
!
    BUFFER_PB[BPB_CUR_PTR] =
      ch$move (.LENGTH, .POINTER, .BUFFER_PB[BPB_CUR_PTR]);
    BUFFER_PB[BPB_BUF_REM] = .BUFFER_PB[BPB_BUF_REM] - .LENGTH;

    if .MORE eql 1		! Start a message sequence
    then
	begin
	BUFFER_PB[BPB_SEQ_COUNT] = .BUFFER_PB[BPB_SEQ_COUNT] + 1;
	return;
	end;

    if .MORE eql 2		! Next message of a message sequence
    then
	return;

    if .MORE eql 3		! Last message of message sequence
    then
	begin
	BUFFER_PB[BPB_SEQ_COUNT] = .BUFFER_PB[BPB_SEQ_COUNT] - 1;
	end;

    ch$wchar (%O'0', .BUFFER_PB[BPB_CUR_PTR]); ! Terminate with null
    SEND_MESSAGE (.TYPE,
                  .ID,
                  ch$ptr (.BUFFER_PB[BPB_BUF_ADR]),
                  .MFLAGS,
                  .AFLAGS);
    BUFFER_PB[BPB_CUR_PTR] = ch$ptr (.BUFFER_PB[BPB_BUF_ADR]);
    BUFFER_PB[BPB_BUF_REM] = TEXT_BUFFER_SIZE;
!
! When at the end of a message sequence, remove queue entry and
! release buffer page
!
    if (.BUFFER_PB[BPB_SEQ_COUNT] eql 0)
    then begin
	 NMU$QUEUE_EXTRACT (QH_BUFFERS, .BUFFER_PB);
         NMU$PAGE_RELEASE (.BUFFER_PB[BPB_BUF_ADR] / PAGE_SIZE);
	 NMU$MEMORY_RELEASE (.BUFFER_PB, BUFFER_PARAMETER_BLOCK_ALLOC);
         end;

    end;				! End of PROCESS_MESSAGE
%routine ('SEND_MESSAGE',TYPE, ID, POINTER, MFLAGS, AFLAGS) : novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!   This routine builds a message block and sends a message  to
!   GALAXY.  If the message text exceeds the size of the MS block,
!   the message is truncated.
!
! FORMAL PARAMETERS
!
!	TYPE    - A value which represents the GALAXY message type
!                 to be built.
!
!	ID      - A value which will be used as the operator's ID
!                 to which this repsonse will be returned.
!
!	POINTER - A character sequence pointer to the text to be sent.
!
! IMPLICIT INPUTS
!
!	NCP_COD   - Contains the GALAXY application code for NCP.
!	NCP_PID   - Our PID for communication with ORION.
!	ORION_PID - ORION's system PID.
!
! ROUTINE VALUE:
!
!	NONE.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    begin

    local
        MESSAGE: ref MS_BLOCK (PAGE_SIZE);

!   Allocate memory for message block, and build the IPCF message

    MESSAGE = (NMU$PAGE_GET () * PAGE_SIZE);
    BUILD_MS_HEADER (.MESSAGE, .TYPE, .ID, .MFLAGS, .AFLAGS);
    BUILD_MS_ACD (.MESSAGE);
    BUILD_MS_TXT (.MESSAGE, .POINTER);

!   Send the response message off to ORION, memory released when transmitted

    NMU$IPCF_TRANSMIT (.NCP_PID,	! From NCP
                       .ORION_PID,	! To ORION
                       .MESSAGE,	! The message block
                       PAGE_SIZE);	! Release page on transmit

    end;				! End of NCP$SEND_RESPONSE
%routine ('BUILD_MS_HEADER', MS_ADDRESS, TYPE, ACK, MFLAGS, AFLAGS) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Builds the header portion of a GALAXY MS IPCF message.
!
! FORMAL PARAMETERS
!
!	MS_ADDRESS - The address of the beginning of an IPCF buffer at
!                    which to write the MS header.
!
!	TYPE       - A value which represents the GALAXY message type
!                    to be built.
!
!       ACK        - A value to be placed in the MS.COD field of the
!                    message header. For the command response message
!                    this must be the contents of the same field in the
!                    received command message.
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
!
!	The address of the next available location in the message.
!
! SIDE EFFECTS:
!
!	The header portion of the message is initialized.
!
!--

    BEGIN

    map
       MS_ADDRESS: ref MS_BLOCK (PAGE_SIZE); ! Structure of the message

    MS_ADDRESS[TYP$MS] = .TYPE;         ! Store message type code
    MS_ADDRESS[FLGMS$] =                ! Clear message header
    MS_ADDRESS[FLAGO$] =
    MS_ADDRESS[ARGCO$] = 0;
    MS_ADDRESS[CODMS$] = .ACK;          ! Unique ACK id
    MS_ADDRESS[CNT$MS] = $OHDRS;        ! Current message length
    MS_ADDRESS[FLGMS$] = .MFLAGS;       ! Set any message flags requested
    MS_ADDRESS[FLAGO$] = .AFLAGS;       ! Set any argument flags

    return .MS_ADDRESS + $OHDRS;        ! Return address of first argument

    END;				! End of BUILD_MS_HEADER
%routine ('BUILD_MS_ACD', MS_ADDRESS) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Builds an application code argument block in a GALAXY MS IPCF message.
!
! FORMAL PARAMETERS
!
!	MS_ADDRESS - The address of the beginning of an MS message.
!
! IMPLICIT INPUTS
!
!	MS_ADDRESS[CNT$MS] - Must contain currently valid length of MS block.
!
! ROUTINE VALUE:
!
!	The address of the next available location in the message.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN


    map
       MS_ADDRESS: ref MS_BLOCK (PAGE_SIZE); ! Structure of the message

    local
         ARG: ref ARG_BLOCK (2);        ! Address of next argument

    ARG = .MS_ADDRESS + .MS_ADDRESS[CNT$MS]; ! Get address of next argument

    ARG[TYP$AR] = $WTACD;               ! First argument is application code
    ARG[LEN$AR] = ACD_LENGTH;           ! Its length is always ACD_LENGTH
    ARG[DA$ARG] = .NCP_COD;             ! Our application code
    MS_ADDRESS[ARGCO$] = .MS_ADDRESS[ARGCO$] + 1; ! Bump argument count
    MS_ADDRESS[CNT$MS] = .MS_ADDRESS[CNT$MS] + ACD_LENGTH; ! Bump length
    ARG = .ARG + ACD_LENGTH;            ! Bump to next argument

    return .MS_ADDRESS + .ARG;          ! Return address of next argument

    end;				! End of BUILD_MS_ACD
%routine ('BUILD_MS_TXT', MS_ADDRESS, POINTER) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Builds a single MS text argument block.
!	If the message text exceeds the space remaining in
!	the MS block, the message text is truncated.
!
! FORMAL PARAMETERS
!
!	MS_ADDRESS - The address of the beginning of the message.
!
!	POINTER    - A character sequence pointer to an ASCIZ string to
!                    be placed in the data portion of the argument block.
!
! IMPLICIT INPUTS
!
!	$WTTXT - The GALAXY code for a text argument block.
!
! ROUTINE VALUE: 
!
!	The address of the next available location in the message.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    BEGIN

    map
       MS_ADDRESS: ref MS_BLOCK (PAGE_SIZE); ! Structure of the message

    local
         LENGTH,                        ! Length of text string
         NULL_PTR,                      ! Pointer used to write null byte
         ARG: ref ARG_BLOCK (2);        ! Address of next argument

    bind
        MS_END = .MS_ADDRESS + PAGE_SIZE;

    ARG = .MS_ADDRESS + .MS_ADDRESS[CNT$MS]; ! Get address of next argument

    ARG[TYP$AR] = $WTTXT;               ! This is text argument

    ! Find minimum of length of text or what the rest of the MS block
    ! can contain, allowing for a null byte to terminate text

    LENGTH = CH$MIN (.POINTER,
                     ch$diff (ch$ptr (MS_END), ch$ptr (ARG[DA$ARG])) - 1);

    NULL_PTR = ch$move(.LENGTH,         ! Length of text to be sent
                       .POINTER,        ! Pointer to text
                       ch$ptr (ARG[DA$ARG])); ! Pointer into message

    ch$wchar (%O'0', .NULL_PTR);        ! Terminate with null byte
    ARG[LEN$AR] = ch$allocation (.LENGTH+1) + 1; ! Length of arg
    MS_ADDRESS[CNT$MS] = .MS_ADDRESS[CNT$MS] + .ARG[LEN$AR]; ! Bump length

    MS_ADDRESS[ARGCO$] = .MS_ADDRESS[ARGCO$] + 1; ! Bump argument count
    return .MS_ADDRESS + .ARG;          ! Return address of next argument

    end;				! End of BUILD_MS_TXT
%routine ('OPR_ID_MATCH',BUFFER_PB,ID) =

!++
! FUNCTIONAL DESCRIPTION:
!
!   Makes determination as to whether this  buffer  parameter  block
!   belongs to the specified operator ID.  This routine is called by
!   NMU$QUEUE_SCAN as an exit routine.
!
! FORMAL PARAMETERS
!
!	BUFFER_PB  - Address of the buffer parameter block to be tested.
!	ID         - Operator Id (PID) to be matched against
!
! IMPLICIT INPUTS
!
!	NONE.
!
! ROUTINE VALUE:
!
!	Address of buffer parameter block if its operator id matches
!	Zero (0), otherwise.
!
! SIDE EFFECTS:
!
!	NONE.
!
!--

    begin

    map
       BUFFER_PB: ref BUFFER_PARAMETER_BLOCK ;

    if .ID eql .BUFFER_PB[BPB_OPR_ID]
    then
	return .BUFFER_PB
    else
	return 0;

    end;				!End of OPR_ID_MATCH
end                                   ! End of Module NCPORI
eludom
! Local Modes:
! Mode:BLISS
! Auto Save Mode:0
! Comment Column:40
! Comment Rounding:+1
! End: