Google
 

Trailing-Edge - PDP-10 Archives - BB-H138F-BM_1988 - 7-sources/m20ipc.b36
There are 10 other files named m20ipc.b36 in the archive. Click here to see a list.
! UPD ID= 29, SNARK:<6.1.NML>NMUIPC.B36.2,  24-May-84 16:13:34 by GLINDELL
! <BRANDT.DEVELOPMENT>NMUIPC.B36.1 5-Aug-82 09:28:28, Edit by BRANDT
!  Ident 9.
!    Change the IPCF receive quota from infinite to 20.
!
! NET:<GROSSMAN.NML-SOURCES>NMUIPC.B36.4 24-Feb-82 09:28:28, Edit by GROSSMAN
!    Add start of System PID table code for Tops-10. This code is used to put
!    NML into the GETTABable PID table, and is what allows NML to get local
!    events on Tops-10.
!NET:<DECNET20-V3P1.NMLLIB>NMUIPC.B36  3-Dec-81 14:44:23, Edit by THIGPEN
!    Ident = X00.08
!    Change calls to NMU$SCHED_WAIT to include an arg specifying timeout
!    interval in seconds
!NET:<GROSSMAN>NMUIPC.B36.3  3-Dec-81 03:13:23, Edit by GROSSMAN
!    Ident = X00.07
!    Fix a bug in NMU$IPCF_CREATE for Tops-10 only. It should not just get
!    the response from [SYSTEM]INFO and throw it away, because on Tops-10 that
!    packet contains valuable info (ie: the symbolic name's pid).
! 30-Nov-81 23:20:56, Edit by GROSSMAN, Ident = X00.07
!    Insert feature tests for Tops-10 compatibility. This edit does not change
!    ANY code produced on Tops-20. Ie: the program should not be affected by
!    this edit at all.
!NET:<DECNET20-V3P1.NMU>NMUIPC.B36.5  1-Oct-81 15:31:02, Edit by BRANDT
!    Impose a quota on the number of IPCF messages that can be queued by
!    the background task, thus preventing a large number of messages from
!    exhausting the available memory resources.
!NET:<DECNET20-V3P1.NMU>NMUIPC.B36.2 19-Jun-81 11:59:48, Edit by JENNESS
!    Change to simpler interrupt system handling.  Change to
!    better JSYS calling conventions.  Readability improvements.
!    Substantial improvements to robustness.
!NET:<DECNET20-V3P1.NMU>NMUIPC.B36.4 27-May-81 08:15:40, Edit by JENNESS
!    Change all routines to give error return values instead of TASK_ERRORs.
!NET:<DECNET20-V3P1.NMU>NMUIPC.B36.2 26-May-81 17:37:38, Edit by GUNN
!    Change NMU$IPCF_ORION to return $TRUE/$FALSE rather then TASK_ERROR,
!    so that caller can retry.
!NET:<DECNET20-V3P1.NMU>NMUIPC.B36.12  4-May-81 12:53:09, Edit by JENNESS
!    Add MUTIL function to set large receive and transmit quotas.
!NET:<DECNET20-V3P1.NMU>NMUIPC.B36.2 25-Mar-81 11:15:49, Edit by JENNESS
!    Add debug tracing and local galaxy dependent on LOCAL_GALAXY flag
!    instead of contents of 135 (.JBOPS).
!NET:<DECNET20-V3P1.NMU>NMUIPC.B36.5  3-Feb-81 10:26:47, Edit by JENNESS
!    Make RECV_SIGNAL conform to interrupt linkage conventions.
!    Make USER_NAME a global routine.
module NMUIPC (					! IPCF interface
		ident = 'X00.09',
		language (bliss36)
		) =
begin
!
!                       COPYRIGHT (C) 1981 BY
!    DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS  01754
!
! THIS SOFTWARE IS FURNISHED  UNDER A LICENSE FOR USE ONLY ON A SINGLE
! COMPUTER  SYSTEM AND  MAY BE  COPIED ONLY 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
! EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO THESE LICENSE
! TERMS.  TITLE TO AND  OWNERSHIP OF THE  SOFTWARE  SHALL AT ALL TIMES
! REMAIN IN DEC.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
! AND SHOULD  NOT BE CONSTRUED  AS A COMMITMENT  BY DIGITAL  EQUIPMENT
! CORPORATION.
!
! DEC ASSUMES  NO  RESPONSIBILITY  FOR  THE USE OR  RELIABILITY OF ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
!

!++
! Facility: LSG DECnet Network Management
!
! Abstract:
!
!       This set of routines provides a interface to the IPCF system
!       on 36 bit machines.  Specifically it is tailored to provide
!       an efficient interface to the GALAXY system.
!
! Environment: TOPS20 user mode
!
! Author: Steven M. Jenness, Creation date: 19 August 1980
!
!--
!
! Include files
!

library 'MXNLIB';			! All required definitions

%if $TOPS20
    %then
	library 'MONSYM';		! Monitor symbols
	library 'MXJLNK';		! JSYS linkage definitions
    %fi

!
! Global routines
!

forward routine
    NMU$IPCF_MANAGER;

!
! Local routines
!

forward routine
    RECV_SIGNAL : IPCF_INTERRUPT_LINKAGE novalue, ! IPCF interrupt routine
    RECEIVE_TASK : novalue,			! IPCF background receiving task
    ALLOW_SEARCH,				! Allow list scanning routine
    ALLOW_KILL,					! Allow list deletiong scanning routine
    USER_NAME : novalue,			! $TEXT user name routine
    %if $TOPS10 %then
    USER_INITIALIZE_NAME : novalue,		! Sets up name string
    SET_IPCF_INTERRUPT : novalue,		! Interrupt for packet receives
    %fi
    NMU$IPCF_SET_SYSPID,			! Sets up GETTABable pid
    JOBNUM;					! Get current job number
!+
! Structure definitions
!-

!
! Packet descriptor block (PDB).
!

field
    PDB_BLOCK_FIELDS =
	set
	PD_FLAGS = [$IPCFL, 0, 36, 0],		! IPCF received flags
	PD_SENDER = [$IPCFS, 0, 36, 0],		! PID of sender
	PD_RECEIVER = [$IPCFR, 0, 36, 0],	! PID message received for
	PD_LENGTH = [$IPCFP, 18, 18, 0],	! Length of message received
	PD_MESSAGE = [$IPCFP, 0, 18, 0],	! Address of message
	%if $TOPS20 %then
	PD_LOGGED = [$IPCFD, 0, 18, 0],		! Sender's logged in directory number
	%else
	PD_LOGGED = [$IPCFU, 0, 36, 0],		! Sender's logged in ppn
	%fi
	PD_CAPABILITIES = [$IPCFC, 0, 36, 0]	! Sender's enabled capabilities
	tes;

literal
    PDB_BLOCK_SIZE = $IPCFC + 1;

macro
    PDB_BLOCK = block [PDB_BLOCK_SIZE] field (PDB_BLOCK_FIELDS) %;

!
! Message descriptor block (MDB).
!
! 	This block contains the queueing information
!	and the PDB (PDB Descriptor Block) for a
!	message that has been received.
!

$field
    MDB_BLOCK_FIELDS =
	set
	MD_QUEUE = [$sub_block (Q_ENTRY_SIZE)],	! Queueing information
	MD_PDB = [$sub_block (PDB_BLOCK_SIZE)]	! PDB block
	tes;

literal
    MDB_BLOCK_SIZE = $field_set_size,
    MDB_BLOCK_ALLOCATION = $field_set_units;

macro
    MDB_BLOCK = block [MDB_BLOCK_SIZE] field (MDB_BLOCK_FIELDS) %;
!
! PID table entry format.
!

$field
    PID_BLOCK_FIELDS =
	set
	PB_MSGS = [$sub_block (QQ_HEADER_SIZE)], ! Queue of received messages
	PB_ALLOW = [$sub_block (Q_HEADER_SIZE)], ! List of allowable senders
	PB_PID = [$integer],			! PID this entry is for
	PB_RESTRICT = [$bit]			! Senders are restricted
	tes;

literal
    PID_BLOCK_SIZE = $field_set_size,
    PID_BLOCK_ALLOCATION = $field_set_units;

macro
    PID_BLOCK = block [PID_BLOCK_SIZE] field (PID_BLOCK_FIELDS) %;

!
! ALLOW queue entry format.
!

$field
    ALLOW_BLOCK_FIELDS =
	set
	AB_Q_INFO = [$sub_block (Q_ENTRY_SIZE)],
	AB_PID = [$integer]
	tes;

literal
    ALLOW_BLOCK_SIZE = $field_set_size,
    ALLOW_BLOCK_ALLOCATION = $field_set_units;

macro
    ALLOW_BLOCK = block [ALLOW_BLOCK_SIZE] field (ALLOW_BLOCK_FIELDS) %;
!
! Literals
!

literal
    IPCF_MSG_QUOTA = 10;		! Max num of IPCF messages to
					!  be queued by background task

!
! Own variables
!

own
    PID_TABLE,
    RECEIVE_EVENT : EVENT_BLOCK,
    IPCF_CHANNEL,
    PID_COUNT;

!
! External references
!

external routine
    NMU$MEMORY_MANAGER,                 ! Memory manager routines
    NMU$QUEUE_MANAGER,                  ! Queue management routines
    NMU$TABLE_ROUTINES,                 ! Table data base management routines
    NMU$PAGE_ALLOCATOR,                 ! Page allocation routines
    NMU$SCHED_MANAGER,                  ! Scheduler
    NMU$TEXT_MANAGER;                   ! Text processing facility

!
! Debugging definitions
!

external
    %debug_data_base;
!
! Tops-10 only definitions to take the place of macros generated by
! DECLARE_JSYS, and simplify some conditionals.
!

    %if $TOPS10 %then
    builtin
	UUO;

    macro
	$$MSEND (LENGTH, ADDRESS) =
	begin
	T1 = LENGTH ^ 18 + ADDRESS;
	UUO (1, IPCFS$ (T1))
	end %;

    macro
	$$MRECV (LENGTH, ADDRESS) =
	begin
	T1 = LENGTH ^ 18 + ADDRESS;
	UUO (1, IPCFR$ (T1))
	end %;

	bind
	    CFV = IP$CFV,
	    CFZ = IP$CFZ;
    %fi

    %if $TOPS20 %then
    bind
	CFV = IP_CFV,
	CFZ = IP_CFZ;
    %fi
%global_routine ('NMU$IPCF_INITIALIZE') : novalue =

!++
! Functional description:
!
!	This routine initializes the data bases required
!	for IPCF processing.  It also starts the IPCF
!	receive background task.
!
! Formal parameters: none
!
! Routine value: none
! Side effects: none
!
!--

    begin
!
! Clear the internal IPCF data base
!
    NMU$TABLE_CLEAR (PID_TABLE);

!
! Setup IPCF receive interrupt event and
! create the receiver task.
!
    NMU$SCHED_EVENT (RECEIVE_EVENT, $true);
    NMU$SCHED_CREATE (RECEIVE_TASK, 200, 0, ch$asciz ('IPCF-BACKGROUND'));

!
! Allocate an interrupt channel and
! activate it.  All PIDs use this channel
! for receiver interrupt service.
!
    IPCF_CHANNEL = ALLOCATE_INTERRUPT_CHANNEL (RECV_SIGNAL);
    ACTIVATE_INTERRUPT (.IPCF_CHANNEL);

    %if $TOPS10 %then
    USER_INITIALIZE_NAME ();			! Get user name string
    SET_IPCF_INTERRUPT (.IPCF_CHANNEL);		! Initialize specific interrupt
    %fi

    end;					! End of NMU$IPCF_INITIALIZE
%global_routine ('NMU$IPCF_FIND_PID', PROCESS_NAME) =

!++
! Functional description:
!
!       This call returns the PID associated with the
!       PROCESS_NAME string.  This is done by issuing
!       a request for the PID to [SYSTEM]INFO.
!
! Formal parameters:
!
!	.PROCESS_NAME	Pointer to ASCIZ name to find the PID for.
!
! Routine value:
!
!      =0    no PID for PROCESS_NAME or failure during query.
!     <>0    PID associated with PROCESS_NAME
!
! Side effects: none
!
!--

    begin

    literal
	INF_BLK_SIZE = 10;

    local
	INF_BLK : vector [INF_BLK_SIZE], 	! [SYSTEM]INFO argument block
	PID_ID,                                 ! Temporary PID
	PTR,					! PTR for process name transfer
	INF_PID,				! [SYSTEM]INFO PID
	INFO_MSG : ref vector [INF_BLK_SIZE],	! Message returned from SYSINF
	dummy;
!
! Get the PID of [SYSTEM]INFO.
!
    if 0 eql (INF_PID = NMU$IPCF_INFO ())
    then return 0;

!
! Get a PID to use temporarily while talking to
! [SYSTEM]INFO.
!
    if 0 eql (PID_ID = NMU$IPCF_CREATE (0, $true))
    then return 0;

!
! Allow [SYSTEM]INFO to send to our temporary PID.
!
    if not NMU$IPCF_ALLOW (.PID_ID, .INF_PID)
    then
        begin
        NMU$IPCF_DESTROY (.PID_ID);
        return 0;
        end;

!
! Make function block for [SYSTEM]INFO query about
! the specified process name.
!
    INF_BLK [$IPCI0] = $IPCIW;
    INF_BLK [$IPCI1] = 0;
    PTR = ch$ptr (INF_BLK [$IPCI2]);
    ch$movasciz (PTR, .PROCESS_NAME);
    ch$wchar_a (0, PTR);

!
! Send the query to [SYSTEM]INFO.
!
    if not NMU$IPCF_TRANSMIT (.PID_ID, .INF_PID, INF_BLK, INF_BLK_SIZE)
    then
        begin
        NMU$IPCF_DESTROY (.PID_ID);
        return 0;
        end;

!
! Get [SYSTEM]INFO's response to our query.
!
    if 0 eql (INFO_MSG = NMU$IPCF_RECEIVE (.PID_ID,dummy,dummy,dummy))
    then
        begin
        NMU$IPCF_DESTROY (.PID_ID);
        return 0;
        end;

!
! Destroy our temporary PID.
!
    NMU$IPCF_DESTROY (.PID_ID);

!
! Check to see if [SYSTEM]INFO had a response for
! us.  If so, return the PID given.  Otherwise
! return the error value of zero (0).
!
    if .INFO_MSG eql 0
    then
	begin
	%debug (IPCF_TRACE,
		(TRACE_INFO ('No PID for %A', .PROCESS_NAME)));
	0
	end
    else
	begin
	builtin
               LSH;
        local
             PID;

	PID = .INFO_MSG [$IPCI1];
	NMU$PAGE_RELEASE (LSH (.INFO_MSG, -9));

	%debug (IPCF_TRACE,
		(TRACE_INFO ('PID for %A is %O,,%O',
			 .PROCESS_NAME, .PID<18, 18>, .PID<0, 18>)));

	.PID
	end

    end;					! End of NMU$IPCF_FIND_PID
%global_routine ('NMU$IPCF_INFO') =

!++
! Functional description:
!
!       This call returns the PID of [SYSTEM]INFO.
!
! Formal parameters: none
!
! Routine value:
!
!    <>0    PID of [SYSTEM]INFO
!     =0    Failure reading [SYSTEM]INFO PID
!
! Side effects: none
!
!--

    %if $TOPS20 %then
    begin

    DECLARE_JSYS (MUTIL)

    local
	ARGBLK : vector [3],
        PID;

    ARGBLK [0] = $MUGTI;
    ARGBLK [1] = 0;
    ARGBLK [2] = 0;

    if $$MUTIL (3, ARGBLK)
    then
        begin
        PID = .ARGBLK [2];

        %debug (IPCF_TRACE,
                (TRACE_INFO ('PID for [SYSTEM]INFO is %O,,%O',
                             .PID<18, 18>, .PID<0, 18>)));
        end
    else
	begin
        PID = 0;

        %debug (IPCF_TRACE,
                (begin
                 TRACE_INFO ('MUTIL ($MUGTI) failed: %J', -1);
                 TRACE_INFO_C ('PID for [SYSTEM]INFO is not available');
                 end));
	end;

!
! Return PID of [SYSTEM]INFO
!
    .PID

    end;					! End of NMU$IPCF_INFO
    %fi
!
! This routine finds the PID of [SYSTEM]INFO for a Tops-10 system
!

    %if $TOPS10 %then
    begin

    builtin
	UUO;

    register
	T1;

    T1 = _SIINF;

    if UUO (1, GETTAB (T1))
    then
        begin
        %debug (IPCF_TRACE,
                (TRACE_INFO ('PID for [SYSTEM]INFO is %O,,%O',
                             .T1<18, 18>, .T1<0, 18>)));
        end
    else
	begin
	T1 = 0;

        %debug (IPCF_TRACE,
                (begin
                 TRACE_INFO ('GETTAB (%SIINF) failed', -1);
                 TRACE_INFO_C ('PID for [SYSTEM]INFO is not available');
                 end));
	end;

!
! Return PID of [SYSTEM]INFO
!
    .T1

    end;					! End of NMU$IPCF_INFO
    %fi
%global_routine ('NMU$IPCF_ORION') =

!++
! Functional description:
!
!       This routine returns the PID for the ORION process
!       that this process is to talk to.
!
! Formal parameters: none
!
! Routine value:
!
!    <>0    If not LOCAL_GALAXY then the PID of the [SYSTEM]ORION.
!           If LOCAL_GALAXY then the PID of the ORION local to
!            the user the job is being run under (e.g. [DAVID]ORION).
!     =0    ORION's PID is not available.
!
! Side effects: none
!
!--

    begin

    local
	PID;

    if LOCAL_GALAXY
    then

!
! Find PID for local (private) GALAXY ORION.
!
	begin

	literal
	    USR_MAX = 39;

	local
	    USRNAM : block [ch$allocation (USR_MAX)];

	$NMU$TEXT (%ref (ch$ptr (USRNAM)), USR_MAX, '[%@]ORION', USER_NAME);

	PID = NMU$IPCF_FIND_PID (ch$ptr (USRNAM));

        %debug (IPCF_TRACE,
                (if .PID neq 0
                 then TRACE_INFO ('PID for %A is %O,,%O',
                                  ch$ptr (USRNAM),
                                  .PID<18, 18>, .PID<0, 18>)
                 else TRACE_INFO ('PID for %A is not available')));
	end
    else

!
! Find PID for [SYSTEM]ORION
!
	%if $TOPS20 %then
	begin

        DECLARE_JSYS (MUTIL)

	local
	    ARGBLK : vector [3];

        ARGBLK [0] = $MURSP;
	ARGBLK [1] = $SPOPR;

	if $$MUTIL (3, ARGBLK)
	then
            begin
            PID = .ARGBLK [2];

            %debug (IPCF_TRACE,
                    (TRACE_INFO ('PID for [SYSTEM]ORION is %O,,%O',
                                 .PID<18, 18>, .PID<0, 18>)));
            end
        else
	    begin
	    PID = 0;

            %debug (IPCF_TRACE,
                    (begin
                     TRACE_INFO ('MUTIL ($MURSP) failed: %J', -1);
                     TRACE_INFO_C ('PID for [SYSTEM]ORION is not available');
                     end));
	    end;
	end;
	%fi
!
! This routine finds the PID for [SYSTEM]ORION for Tops-10
!

	%if $TOPS10 %then
	begin

	builtin
	    UUO;

	register
	    T1;

	T1 = _SIOPR;

	if UUO (1, GETTAB (T1))
	then
	    begin
	    %debug (IPCF_TRACE,
		    (TRACE_INFO ('PID for [SYSTEM]ORION is %O,,%O',
				 .T1<18, 18>, .T1<0, 18>)));
	    end
	else
	    begin
	    T1 = 0;

	    %debug (IPCF_TRACE,
		    (begin
		     TRACE_INFO ('GETTAB (%SIOPR) failed', -1);
		     TRACE_INFO_C ('PID for [SYSTEM]ORION is not available');
		     end));
	    end;

	PID = .T1;
	end;
	%fi

!
! Return PID of ORION
!
    .PID

    end;					! End of NMU$IPCF_ORION
%global_routine ('NMU$IPCF_CREATE', PROCESS_NAME, RESTRICT) =

!++
! Functional description:
!
!       This routine creates a PID for the current process.  The
!       name string in PROCESS_NAME is associated with the PID.
!	If no process name is specified, one is created of the
!	form: [user-id]JOBnn-PIDmm.
!
! Formal parameters:
!
!       .PROCESS_NAME	Pointer to the name for this PID
!			(if zero (0) then no name is assigned).
!	.RESTRICT	$TRUE	Restrict who can send to this PID.
!			$FALSE	Any PID can send to this PID.
!
! Routine value:
!
!    <>0    NMU$IPCF ID assigned to the process
!     =0    failure while getting PID for the process
!
! Side effects: none
!
!--

    begin

    %if $TOPS20 %then
    DECLARE_JSYS (MSEND, MUTIL)
    %fi %if $TOPS10 %then
    builtin
	UUO;

    register
	T1;
    %fi

    literal
	INF_BLK_SIZE = 10;

    local
	PID,					! PID allocated
	PID_NUMBER,				! Count of PID's in process
        PID_ID,                                 ! Index into PID_TABLE
	JOB_NUMBER,				! Current job number
	PID_INFO : ref PID_BLOCK,		! PID_TABLE entry block
	INF_BLK : vector [INF_BLK_SIZE],	! [SYSTEM]INFO function block
	PDB : PDB_BLOCK;			! MSEND argument block

!
! Get PID count for this process and
! the job number.
!
	PID_NUMBER = (PID_COUNT = .PID_COUNT + 1);
	JOB_NUMBER = JOBNUM ();

!
! Copy the process' name into the [SYSTEM]INFO
! function block.
!
    if .PROCESS_NAME eql 0 or LOCAL_GALAXY
    then
	begin
	$NMU$TEXT (%ref (ch$ptr (INF_BLK [$IPCI2])),
		   29,
		   '[%@]J%D-P%D',
		   USER_NAME, .JOB_NUMBER, .PID_NUMBER);
	end
    else
	begin
	local PTR;
	PTR = ch$ptr (INF_BLK [$IPCI2]);
	ch$movasciz (PTR, .PROCESS_NAME);
	ch$wchar_a (0, PTR);
	end;

    %debug (IPCF_TRACE,
	    (TRACE_INFO ('Creating PID for %A', ch$ptr (INF_BLK [$IPCI2]))));

%if $TOPS10
%then
!   if LOCAL_GALAXY
!   then
!	begin
%fi
	!
	! Setup rest of [SYSTEM]INFO function block.
	!
	    INF_BLK [$IPCI0] = $IPCII;		! Assign PID to name function
	    INF_BLK [$IPCI1] = 0;		! No extra copies of response

	    %if $TOPS20 %then
	    PDB [PD_FLAGS] = IP_CPD;		! Create a PID
	    %fi %if $TOPS10 %then
	    PDB [PD_FLAGS] = 0;			! No special flags
	    %fi
	    PDB [PD_MESSAGE] = INF_BLK;		! Address of message
	    PDB [PD_SENDER] = 0;		! No sender's PID (yet).
	    PDB [PD_RECEIVER] = 0;		! Receiver is [SYSTEM]INFO.
	    PDB [PD_LENGTH] = INF_BLK_SIZE;

%if $TOPS10
%then
!	end
!   else
!	begin
!
!	    !
!	    ! Create PID using [SYSTEM]IPCC
!	    !
!
!	    T1 = _SIIPC;			! Get [SYSTEM]IPCC's PID
!	    if UUO (1, GETTAB(T1))
!	    then
!		begin
!		    %debug (IPCF_TRACE,
!			    (TRACE_INFO ('PID for [SYSTEM]IPCC is %O,,%O',
!					 .T1<18,18>, .T1<0,18>)));
!		end
!	    else
!		begin
!		    T1 = -1;
!		    %debug (IPCF_TRACE,
!			    (begin
!			     TRACE_INFO ('GETTAB (%SIIPC) failed', -1);
!			     TRACE_INFO_C ('PID for [SYSTEM]IPCC is not available');
!			     end));
!		end;
!	    INF_BLK [$IPCI0] = $IPCSC;		! Create a PID
!	    INF_BLK [$IPCI1] = 1^35 + .JOB_NUMBER;	! For my job
!
!	    PDB [PD_FLAGS] = IP$CFP;		! Privileged request
!	    PDB [PD_MESSAGE] = INF_BLK;		! Address of message
!	    PDB [PD_SENDER] = 0;		! No sender's PID (yet).
!	    PDB [PD_RECEIVER] = .T1;		! Receiver is [SYSTEM]IPCC.
!	    PDB [PD_LENGTH] = INF_BLK_SIZE;
!	end;
%Fi ! End %if $TOPS10
%IF %SWITCHES(TOPS10) %THEN

    pdb[pd_receiver] = nmu$ipcf_info();
    pdb[pd_message] = inf_blk;
    pdb[pd_sender] = 0;
    pdb[pd_length] = inf_blk_size;
%FI

!
! Send PID request to [SYSTEM]INFO
!
    if not $$MSEND (PDB_BLOCK_SIZE, PDB)
    then
        begin
	%if $TOPS20 %then
        %debug (IPCF_TRACE,
                (TRACE_INFO ('MSEND failed: %J', -1)));
	%fi

	%if $TOPS10 %then
        %debug (IPCF_TRACE,
                (TRACE_INFO ('MSEND failed: %O', .T1)));
	%fi
        return 0;
        end;

    %if $TOPS10 %then
    if	not $$MRECV (PDB_BLOCK_SIZE, PDB, ERRCOD)
	or (IP$CFE and .PDB [PD_FLAGS]) neq 0
	then
	    begin
	    TRACE_INFO ('PID creation failed: %O', POINTR(.T1, IP$CFE));
	    return 0;
	    end;
!   if LOCAL_GALAXY
!   then
 	PDB [PD_SENDER] = .INF_BLK [$IPCI1] ;
!   else
!	PDB [PD_SENDER] = .INF_BLK [$IPCI2];
    %fi

    PID = .PDB [PD_SENDER];             ! Set assigned PID

!
! Create the PID information block and
! put it into the PID_TABLE.
!
    PID_INFO = NMU$MEMORY_GET (PID_BLOCK_ALLOCATION);
    PID_INFO [PB_PID] = .PID;
    PID_INFO [PB_RESTRICT] = $false;

    NMU$QUEUE_RESET (PID_INFO [PB_ALLOW]);
    NMU$QQUEUE_RESET (PID_INFO [PB_MSGS], IPCF_MSG_QUOTA);
    PID_ID = (NMU$TABLE_INSERT (PID_TABLE, .PID_INFO));

!
! Enable interrupts to occur for the PID.
!
    %if $TOPS20 %then
    begin
        local
             ARGBLK : vector [3];

        ARGBLK [0] = $MUPIC;
        ARGBLK [1] = .PID;
	ARGBLK [2] = .IPCF_CHANNEL;
	if not $$MUTIL (3, ARGBLK)
        then TRACE_INFO ('MUTIL ($MUIPC) failed: %J', -1);
    end;
    %fi

!
! Get the response from [SYSTEM]INFO and throw it away.
!
    %if $TOPS20 %then
    begin
        builtin LSH;
        local
	     dummy,
             MSG;

        MSG = NMU$IPCF_RECEIVE (.PID_ID,dummy,dummy,dummy);
        NMU$PAGE_RELEASE (LSH (.MSG, -9));
    end;
    %fi

!
! Set real receive restriction.
!
    PID_INFO [PB_RESTRICT] = .RESTRICT;

    %debug (IPCF_TRACE,
	    (TRACE_INFO ('PID %O,,%O assigned',
				.PID<18, 18>, .PID<0, 18>)));

!
! Set large send and receive quotas
!
    %if $TOPS20 %then
    begin
         local
              ARGBLK : vector [3];

         ARGBLK [0] = $MUSSQ;
         ARGBLK [1] = .PID;
         ARGBLK [2] = %o'000000777024';

         if not $$MUTIL (3, ARGBLK)
         then TRACE_INFO ('MUTIL ($MUSSQ) failed: %J', -1);
    end;
    %fi

!   %if $TOPS10
!   %then
!	INF_BLK [$IPCI0] = $IPCSQ;		! Set quotas
!	INF_BLK [$IPCI1] = .JOB_NUMBER;		! For me
!	INF_BLK [$IPCI2] = %o '000000777777';	! To large numbers
!
!	T1 = _SIIPC;				! Gettab for
!	UUO (1, GETTAB (T1));			!  [SYSTEM]IPCC
!
!	PDB [PD_FLAGS] = IP$CFP;		! Say we are privileged
!	PDB [PD_SENDER] = 0;			! Just us
!	PDB [PD_RECEIVER] = .T1;		! PID of [SYSTEM]IPCC
!	PDB [PD_LENGTH] = 3;			! Length of message
!	PDB [PD_MESSAGE] = INF_BLK;		! Message address
!
!	if not $$MSEND (PDB_BLOCK_SIZE, PDB, ERRCOD)
!	   or not $$MRECV (PDB_BLOCK_SIZE, PDB, ERRCOD)
!	   or (IP$CFE and .PDB [PD_FLAGS]) neq 0
!	then
!	    TRACE_INFO ('Can''t set IPCF quotas %O', POINTR(.T1, IP$CFE));

!	if not LOCAL_GALAXY
!	then
!	    NMU$IPCF_SET_SYSPID ($IPCNM, .PID);
!   %fi

!
! Return assigned PID index
!

    .PID_ID

    end;					! End of NMU$IPCF_CREATE
%global_routine ('NMU$IPCF_DESTROY', PID_ID) =

!++
! Functional description:
!
!	This routine deletes the data base assigned to a
!	particular PID.  It also notifies the monitor that
!	the PID is no longer valid.
!
! Formal parameters:
!
!	.PID_ID    Index into PID_TABLE for PID to be deleted.
!
! Routine value:
!
!    $true    PID was destroyed
!    $false   Failure during destruction attempt
!
! Side effects: none
!
!--

    begin

    %if $TOPS20 %then
    DECLARE_JSYS (MUTIL)
    %fi

    %if $TOPS10 %then
    register
	T1;

    local
	INF_BLK : vector [10],		! [SYSTEM]INFO argument block
	PDB : PDB_BLOCK,		! Argument block for IPCF functions
	ERRCOD;
    %fi

    local
	ARGBLK : vector [3],			! MUTIL argument block
        PID_INFO : ref PID_BLOCK;

!
! Lookup PID info block
!
    if not NMU$TABLE_FETCH (PID_TABLE, .PID_ID, PID_INFO)
    then
        begin
        %debug (IPCF_TRACE,
                (TRACE_INFO ('Illegal NMU$IPCF ID')));
        return $false;
        end;

!
! Tell IPCF system that PID is to be destroyed
!
    %if $TOPS20 %then
    ARGBLK [0] = $MUDES;
    ARGBLK [1] = .PID_INFO [PB_PID];
    $$MUTIL (3, ARGBLK);
    %fi

    %if $TOPS10 %then
    INF_BLK [$IPCI0] = $IPCID;			! Drop this PID
    INF_BLK [$IPCI1] = 0;			! No PID for copy
    INF_BLK [$IPCI2] = .PID_INFO [PB_PID];	! PID to be destroyed

    PDB [PD_FLAGS] = 0;				! No special flags
    PDB [PD_SENDER] = 0;			! Me
    PDB [PD_RECEIVER] = 0;			! [SYSTEM]INFO
    PDB [PD_MESSAGE] = INF_BLK;			! Address of arg block
    PDB [PD_LENGTH] = 3;			! ...

    $$MSEND (PDB_BLOCK_SIZE, PDB);
    $$MRECV (PDB_BLOCK_SIZE, PDB);
    %fi

    %debug (IPCF_TRACE,
	    (begin
             local
                  PID;
             PID = .PID_INFO [PB_PID];
             TRACE_INFO ('PID %O,,%O destroyed', .PID<18, 18>, .PID<0, 18>);
             end));

!
! Delete PID table entry for destroyed PID.
!
    NMU$TABLE_DELETE (PID_TABLE, .PID_ID);

!*****
!
! Release any messages queued for reception ...
!
!*****

    NMU$MEMORY_RELEASE (.PID_INFO, PID_BLOCK_ALLOCATION);

    $true

    end;					! End of NMU$IPCF_DESTROY
%global_routine ('NMU$IPCF_ALLOW', DST_PID_ID, SRC_PID) =

!++
! Functional description:
!
!	This routine inserts a SRC_PID into the list of allowable
!	PIDs that can send to this process' DST_PID.
!
! Formal parameters:
!
!	.DST_PID_ID	Index for this process' PID info block.
!	.SRC_PID	PID of a possible valid sender.
!
! Routine value:
!
!    $true    Allowable PID set up
!    $false   PID ID is invalid
!
! Side effects: none
!
!--

    begin

    local
	PID_INFO : ref PID_BLOCK,
	ALLOW_ENTRY : ref ALLOW_BLOCK;

!
! Lookup PID info block
!
    if not NMU$TABLE_FETCH (PID_TABLE, .DST_PID_ID, PID_INFO)
    then
        begin
        %debug (IPCF_TRACE,
                (TRACE_INFO ('Illegal NMU$IPCF ID')));
        return $false;
        end;

    %debug (IPCF_TRACE,
	    (begin
             local
                  DST_PID;

             DST_PID = .PID_INFO [PB_PID];

             TRACE_INFO ('Allowing PID %O,,%O to send to %O,,%O',
			 .SRC_PID<18, 18>, .SRC_PID <0, 18>,
			 .DST_PID<18, 18>, .DST_PID <0, 18>);
             end));

!
! Allocate a "Allow" block to be linked into queue
! of allow blocks for the destination PID.
!
    ALLOW_ENTRY = NMU$MEMORY_GET (ALLOW_BLOCK_ALLOCATION);
    ALLOW_ENTRY [AB_PID] = .SRC_PID;
    NMU$QUEUE_INSERT (PID_INFO [PB_ALLOW], .ALLOW_ENTRY);

    $true
    end;					! End of NMU$IPCF_ALLOW
%global_routine ('NMU$IPCF_DISALLOW', DST_PID_ID, SRC_PID) =

!++
! Functional description:
!
!	This routine removes a SRC_PID from the list
!	of PIDs that are allowed to send the this
!	process' DST_PID
!
! Formal parameters:
!
!	.DST_PID_ID	Index to this process' PID info block.
!	.SRC_PID	PID to disallow sending to us.
!
! Routine value:
!
!    $true    Allowable PID set up
!    $false   PID ID is invalid
!
! Side effects: none
!
!--

    begin

    local
	PID_INFO : ref PID_BLOCK,
	ALLOW_ENTRY : ref ALLOW_BLOCK;

!
! Lookup PID info block
!
    if not NMU$TABLE_FETCH (PID_TABLE, .DST_PID_ID, PID_INFO)
    then
        begin
        %debug (IPCF_TRACE,
                (TRACE_INFO ('Illegal NMU$IPCF ID')));
        return $false;
        end;

    %debug (IPCF_TRACE,
	    (begin
             local
                  DST_PID;

             DST_PID = .PID_INFO [PB_PID];
             TRACE_INFO ('Disallowing PID %O,,%O to send to %O,,%O',
			 .SRC_PID<18, 18>, .SRC_PID<0, 18>,
			 .DST_PID<18, 18>, .DST_PID<0, 18>);
             end));

!
! Delete any allow block that specifies the
! source pid can send to the destination PID.
!
    NMU$QUEUE_SCAN (PID_INFO [PB_ALLOW], .SRC_PID, ALLOW_KILL);

    $true

    end;					! End of NMU$IPCF_DISALLOW
%global_routine ('NMU$IPCF_TRANSMIT', SRC_ID, DST, MSG, LEN) =

!++
! Functional description:
!
!       This routine transmits an IPCF message to the specified
!       destination PID.  If the length of the message is 512 (10)
!       words in length, a page mode send is done.
!
!
! Formal parameters:
!
!       .SRC_ID   Source PID (for this process)
!       .DST      Destination PID
!       .MSG      Address of message block
!       .LEN      Number of words in message
!
! Routine value:
!
!    $true    Send completed successfully
!    $false   Send failed
!
! Side effects:
!
!       If a page mode send is done, the message block
!       is not returned to the caller.  It is removed from
!       the process' page map.
!
!--

    begin

    %if $TOPS20 %then
    DECLARE_JSYS (MSEND)
    %fi %if $TOPS10 %then
    register
	T1;
    %fi

    local
	PDB : PDB_BLOCK,
	DUMP_PAGE,
        PID_INFO : ref PID_BLOCK,
        SRC;

    builtin
	LSH;

!
! Lookup PID info block
!
    if not NMU$TABLE_FETCH (PID_TABLE, .SRC_ID, PID_INFO)
    then
        begin
        %debug (IPCF_TRACE,
                (TRACE_INFO ('Illegal NMU$IPCF ID')));
        return $false;
        end;

!
! Set source PID for sending
!
    SRC = .PID_INFO [PB_PID];

!
! Display tracing information about from and to whom the
! current packet is being sent.
!
    %debug (IPCF_TRACE,
	    (begin
	     TRACE_INFO ('Sending packet from %O,,%O to %O,,%O',
			 .SRC<18, 18>, .SRC<0, 18>, .DST<18, 18>, .DST<0, 18>);
	     TRACE_INFO (' message at %O, length %D', .MSG, .LEN);
	     end));
!
! Initially assume that a non-page mode send
! is being done.
!
    DUMP_PAGE = $false;

!
! Check for a page mode send
!
    if .LEN eql 512
    then
	begin
!
! On page mode,
!    indicate page mode send
!    set page number to send
!    set flag to dump page (release it) on successful send
!
	PDB [PD_FLAGS] = CFV;
	PDB [PD_MESSAGE] = LSH (.MSG, -9);
	DUMP_PAGE = $true;
	end
    else
	begin
!
! On non-page mode,
!    indicate packet mode send
!    set address to send
!
	PDB [PD_FLAGS] = 0;
	PDB [PD_MESSAGE] = .MSG;
	end;

!
! Set the source and destination PIDs
! Set the size (in words) of the message to send.
!
    PDB [PD_SENDER] = .SRC;
    PDB [PD_RECEIVER] = .DST;
    PDB [PD_LENGTH] = .LEN;

!
! Attempt to do the send
!
    if not $$MSEND (PDB_BLOCK_SIZE, PDB)
    then
        begin
	%if $TOPS20 %then
        %debug (IPCF_TRACE,
                (TRACE_INFO ('MSEND failed: %J', -1)));
	%fi %if $TOPS10 %then
        %debug (IPCF_TRACE,
                (TRACE_INFO ('IPCFS. failed: %O', .T1)));
	%fi
        return $false;
        end;

!
! If a page mode send was done, release the page
!
    if .DUMP_PAGE then
    begin
	%if $TOPS10 %then
	! The following is a CROCK only for Tops-10. It recreates the page
	!  that was destroyed by an IPCFS. so that the page allocator can
	!  can deallocate the page without getting an ?Ill mem ref.
	local
	    ARGLST : vector [2];

	ARGLST [0] = 1;
	ARGLST [1] = LSH (.MSG, -9);

	T1 = $PAGCD ^ 18 + ARGLST;

	UUO (1, PAGE$(T1));
	%fi

        NMU$PAGE_RELEASE (LSH (.MSG, -9));
    end;

!
! Indicate everything worked ok
!
    $true

    end;					! End of NMU$IPCF_TRANSMIT
%global_routine ('NMU$IPCF_RECEIVE', DST_PID_ID,sender_pid_,user_id_,caps_) =

!++
! Functional description:
!
!       This routine receives an IPCF message incoming for
!       the specified PID.  It blocks until a message is
!       received.
!
! Formal parameters:
!
!       .DST_PID_ID    Index to PID info block in PID table.
!
! Routine value:
!
!       Address of message page.
!
! Side effects: none
!
!       The message block is always a page,
!       whether a page mode receive was done or not.
!
!--

    begin
    bind
	sender_pid = .sender_pid_,
	user_id = .user_id_,
	caps = .caps_;

    local
	PID_INFO : ref PID_BLOCK,
        DST_PID,
	MSG_MDB : ref MDB_BLOCK,
	PDB : ref PDB_BLOCK,
	MSG_ADDRESS,
	MSG_FOUND;

    sender_pid = user_id = caps = 0;
!
! Lookup PID info block
!
    if not NMU$TABLE_FETCH (PID_TABLE, .DST_PID_ID, PID_INFO)
    then
        begin
        %debug (IPCF_TRACE,
                (TRACE_INFO ('Illegal NMU$IPCF ID')));
        return $false;
        end;

    DST_PID = .PID_INFO [PB_PID];

!
! Indicate that so far no message has been found
! for the specified pid.
!
    MSG_FOUND = $false;

!
! Until a message has been found
!
    while not .MSG_FOUND do
	begin

!
! Get the next message descriptor from the queue of
! messages for this pid.
!
	MSG_MDB = NMU$QQUEUE_REMOVE (PID_INFO [PB_MSGS]);

!
! Set the address of the message's PDB (packet descriptor)
!
	PDB = MSG_MDB [MD_PDB];

!
! Check to see if the message was a packet or page mode
! receive.  Set the message's address appropriately.
!
	if (.PDB [PD_FLAGS] and CFV) eql 0
	then
	    MSG_ADDRESS = .PDB [PD_MESSAGE]
	else
	    begin
	    builtin LSH;
	    MSG_ADDRESS = LSH (.PDB [PD_MESSAGE], 9);
	    end;

!
! Display tracing information telling where the packet came
! from and who it is for.
!
	%debug (IPCF_TRACE,
		(begin
		 local SRC_PID;
		 SRC_PID = .PDB [PD_SENDER];
		 TRACE_INFO ('Received packet for %O,,%O, from %O,,%O',
				.DST_PID<18, 18>, .DST_PID<0, 18>,
				.SRC_PID<18, 18>, .SRC_PID<0, 18>);
		 end));

!
! Check to see if the receiving PID has receive restrictions
! on it.  If not .. just receive the message.  If there are
! restrictions check to see if the sending PID is allowed.
! If it isn't .. delete the message
!
	if not .PID_INFO [PB_RESTRICT]
	then
	    MSG_FOUND = $true
	else
	    if not (MSG_FOUND = NMU$QUEUE_SCAN (PID_INFO [PB_ALLOW],
                                                .PDB [PD_SENDER],
                                                ALLOW_SEARCH))
	    then
		begin
		builtin LSH;
		NMU$PAGE_RELEASE (LSH (.MSG_ADDRESS, -9));
		%debug (IPCF_TRACE,
			(TRACE_INFO ('Packet disallowed - deleted')));
		end;
!
! Set the Sender_pid, User_id, and Capabilities of Sender
!

![308] DON'T RETURN INFO'S PID
        IF (.pdb[pd_flags] AND ip_cfc) LEQ 1    ![308]
        THEN                                    ![308]
            sender_pid = .pdb[pd_sender];

	user_id = .pdb[pd_logged];
	caps = .pdb[pd_capabilities];
!
! Release the message descriptor block
!
	NMU$MEMORY_RELEASE (.MSG_MDB, MDB_BLOCK_ALLOCATION);
	end;

!
! Display where the message is in core and return
! its address
!
    %debug (IPCF_TRACE,
	    (TRACE_INFO ('Packet at %O', .MSG_ADDRESS)));

    .MSG_ADDRESS
    end;					! End of NMU$IPCF_RECEIVE
%global_routine ('NMU$IPCF_MAP_ID', PID_ID) =

!++
! Functional description:
!
!        This routine maps a NMU$IPCF id into a IPCF system PID.
!
! Formal parameters:
!
!    .PID_ID    NMU$IPCF ID returned from NMU$IPCF_CREATE
!
! Routine value:
!
!    <>0    PID associated with PID_ID
!     =0    Invalid PID_ID
!
! Side effects: none
!
!--

    begin

    local
         PID_INFO : ref PID_BLOCK;

!
! Lookup PID info block
!
    if not NMU$TABLE_FETCH (PID_TABLE, .PID_ID, PID_INFO)
    then
        begin
        %debug (IPCF_TRACE,
                (TRACE_INFO ('Illegal NMU$IPCF ID')));
        return 0;
        end;

!
! Return PID from info block
!
    .PID_INFO [PB_PID]

    end;					! End of NMU$IPCF_MAP_ID
%routine ('NMU$IPCF_SET_SYSPID', SPIDX, PID) =

!++
!
! Functional description:
!
!	This routine is called in order to put us into the GETTABable PID
!	table.  It takes no arguments.
!
! Formal parameters:
!
!	SPIDX			System PID index
!	PID			PID of process
!
! Routine value:
!
!	$true			The syspid was assigned
!	$false			The syspid could not be assigned to this job
!
!--

begin

%if $TOPS10
%then
    local
	ARGLST : PDB_BLOCK,		! IPCF argument list
	MESSAGE : vector [3];		! Message for [SYSTEM]IPCC

    builtin
	UUO;

    register
	T1;

    T1 = _SIIPC;		! GETTAB the
    if not UUO (1, GETTAB (T1)) !  pid of [SYSTEM]IPCC
       then return $false;

    ARGLST [PD_FLAGS] = IP$CFP;	! Priveleged packet
    ARGLST [PD_SENDER] = .PID;	! Sender is me
    ARGLST [PD_RECEIVER] = .T1;	! Receiver is [SYSTEM]IPCC
    ARGLST [PD_LENGTH] = 3;	! Length
    ARGLST [PD_MESSAGE] = MESSAGE; ! Pointer to message block

    MESSAGE [$IPCS0] = $IPCWP;	! Write the pid table
    MESSAGE [$IPCS1] = .SPIDX;	! System PID table offset
    MESSAGE [$IPCS2] = .PID;	! PID to set up

    T1 = 4 ^ 18 + ARGLST;	! AC for IPCFS.
    if not UUO (1, IPCFS$ (T1)) ! Set the SYSPID
       then return $false;

    if not UUO (1, IPCFR$ (T1))	! Get the response
       then return $false;

    if (.ARGLST[PD_FLAGS] and IP$CFE) neq 0 ! Any errors?
       then return $false;	! Yes, die
%fi ! end %if $TOPS10

    $true
end;
%routine ('RECV_SIGNAL') IPCF_INTERRUPT_ROUTINE novalue =

!++
! Functional description:
!
!	This routine is called whenever a IPCF message interrupt occurs.
!
! Formal parameters: none
!
! Routine value: none
! Side effects:
!
!	The message received event is signalled.  This causes the
!	RECEIVE_TASK to be scheduled (sometime).
!
!--

    begin
    NMU$SCHED_FLAG (RECEIVE_EVENT);
    PROCESS_WAKE;
    end;			! End of RECV_SIGNAL
%routine ('RECEIVE_TASK') : novalue =

!++
! Functional description:
!
!       This is the IPCF receive background task.  It waits until
!       a IPCF event occurs.  Then it attempts to receive any
!       IPCF message that is waiting.  Received IPCF messages are
!       queued to the appropriate PID on the PID_TABLE (if it exists).
!
! Formal parameters: none
!
! Routine value: none
! Side effects:
!
!       The PID_TABLE entry for some PID may be modified to
!       reflect the reception of a message.  Also if a task
!       is waiting for a message on a specific PID, and the
!       message is for the PID, the task is made schedulable.
!
!--

    begin

    %if $TOPS20 %then
    DECLARE_JSYS (MUTIL, MRECV)
    %fi

    %if $TOPS10 %then register T1; %fi

    local
	MDB : ref MDB_BLOCK,                  ! Message descriptor block
	PDB : ref PDB_BLOCK,                  ! Packet descriptor block
	ARGBLK : vector [PDB_BLOCK_SIZE + 2], ! MUTIL argument block
	PID_INFO : ref PID_BLOCK,             ! PID information block
	MSG,                                  ! Message page address
        PID_ID,                               ! PID ID for searching
        MAX_PID_ID;                           ! Maximum ID in PID_TABLE

    bind
	NEW_PDB = ARGBLK [1] : PDB_BLOCK;

    builtin
	LSH;

!
! Loop forever receiving messages
!
    while $true
    do

!
! Loop while a message is waiting
!
      begin

      while
           begin
	   %if $TOPS20 %then
           ARGBLK [0] = $MUQRY;
           ARGBLK [1] = -1;		! Receive for any PID of this process
           $$MUTIL (PDB_BLOCK_SIZE + 2, ARGBLK)
	   %fi

	   %if $TOPS10 %then
	   register
		T1;

	   T1 = (PDB_BLOCK_SIZE + 2) ^ 18 + ARGBLK + 1;
	   UUO (1, IPCFQ$ (T1))
	   %fi
           end
      do
        begin
!
! Get a message descriptor (MDB) block
! Set the address of the packet (PDB) desciptor block
!
        MDB = NMU$MEMORY_GET (MDB_BLOCK_ALLOCATION);
        PDB = MDB [MD_PDB];

!
! Check if a message is associated with the IPCF packet.
! If it is, get a page to receive it into.
!
        if (.NEW_PDB [PD_FLAGS] and CFZ) neq 0
        then MSG = 0
        else MSG = NMU$PAGE_GET ();

!
! Set reception flags and receive buffer address
!
        if (.NEW_PDB [PD_FLAGS] and CFV) neq 0
        then
            begin
	    %if $TOPS10 %then
	    ! The following crock is related to the crock you probably
	    !  saw a few pages back. This one ensures that the page
	    !  that an IPCFR. is going to use, does not exist.
	    local
		ARGLST : vector [2];
	    ARGLST [0] = 1;
	    ARGLST [1] = PA$GAF + .MSG;
	    T1 = $PAGCD ^ 18 + ARGLST;
	    UUO (1, PAGE$(T1));
	    %fi
            PDB [PD_FLAGS] = CFV;	        ! Receive in page mode
            PDB [PD_MESSAGE] = .MSG;	        ! Page to receive message
            end
        else
            begin
            PDB [PD_FLAGS] = 0;		        ! Packet mode receive
            PDB [PD_MESSAGE] = LSH (.MSG, 9);	! Address of receive message
            end;

!
! Receive for any pid into the 512 word buffer
!
        PDB [PD_RECEIVER] = -1;
        PDB [PD_LENGTH] = 512;

!
! Do the receive, display errors, and release
! the memory space allocated on failures
!
        if not $$MRECV (PDB_BLOCK_SIZE, .PDB)
        then
            begin
            %debug (IPCF_TRACE,
                    (TRACE_INFO ('MRECV failed: %J', -1)));

            NMU$PAGE_RELEASE (.MSG);
            NMU$MEMORY_RELEASE (.MDB, MDB_BLOCK_ALLOCATION);
            end
        else
            begin

!
! On successful read, find the PID in the PID_TABLE
! that the message was received for.   Put the message
! onto the queue for the PID.
!
            PID_ID = 0;

            if (MAX_PID_ID = NMU$TABLE_MAX (PID_TABLE)) eql  0
            then PID_INFO = 0
            else
                while (PID_ID = .PID_ID + 1) leq .MAX_PID_ID
                do
                  if not NMU$TABLE_FETCH (PID_TABLE, .PID_ID, PID_INFO)
                  then PID_INFO = 0
                  else
                      if .PID_INFO [PB_PID] eql .PDB [PD_RECEIVER]
                      then exitloop;

            if .PID_INFO eql 0
            then
                begin
                %debug (IPCF_TRACE,
                        (TRACE_INFO ('Message received for unknown PID')));
                NMU$PAGE_RELEASE (.MSG);
                NMU$MEMORY_RELEASE (.MDB, MDB_BLOCK_ALLOCATION);
                end
            else
                NMU$QQUEUE_INSERT (PID_INFO [PB_MSGS], .MDB);

            end;
        end;

!
! Wait until an IPCF message comes in
!
      NMU$SCHED_WAIT(RECEIVE_EVENT,0);		! Wait for next IPCF interrupt
      end;					! no timeout needed

    end;					! End of RECEIVE_TASK
%routine ('ALLOW_SEARCH', ALLOW_ENTRY : ref ALLOW_BLOCK, PID) =

!++
! Functional description:
!
!       This routine is the scanning routine used by NMU$IPCF when
!       calling NMU$QUEUE_SCAN to search the allowable pid queue
!       to see if a PID is a valid sender.
!
! Formal parameters:
!
!       .ALLOW_ENTRY  Address of current allowable PID entry.
!       .PID          PID that is being searched for.
!
! Routine value:
!
!       $FALSE (0) if no match.
!       $TRUE if a match is found.
!
! Side effects: none
!
!--

    begin

    if .ALLOW_ENTRY [AB_PID] eql .PID
    then $true
    else $false

    end;					! End of ALLOW_SEARCH
%routine ('ALLOW_KILL', ALLOW_ENTRY : ref ALLOW_BLOCK, PID) =

!++
! Functional description:
!
!	This routine is called by NMU$QUEUE_SCAN when doing
!	a scan of a "allowable" PID list.  If the specified
!	PID is found, it is deleted from the list.
!
! Formal parameters:
!
!	.ALLOW_ENTRY	Address of current allow block.
!	.PID		PID being looked for.
!
! Routine value:
!
!	$true	if entry has been found and deleted
!	$false	if entry does not match
!
! Side effects: none
!
!--

    begin

    if ALLOW_ENTRY [AB_PID] eql .PID
    then
	begin
	NMU$QUEUE_EXTRACT (0, .ALLOW_ENTRY);
	NMU$MEMORY_RELEASE (.ALLOW_ENTRY, ALLOW_BLOCK_ALLOCATION);
	$true
	end
    else
	$false

    end;					! End of ALLOW_KILL
%if $TOPS10 %then
%routine ('USER_INITIALIZE_NAME') : novalue =

!++
! Functional description:
!
!	This routine puts the current job's user name
!	into a special holding area.
!
! Formal parameters:
!
!	None
! Routine value: none
! Side effects: USER_STRING_NAME is set up
!
!--

    begin

	builtin
	    UUO;

	register
	    T1;

	global
	    USER_STRING_NAME : vector [ch$allocation (13)];

	local
	    PTR;

	UUO (0, GETPPN(T1));

	PTR = ch$ptr (USER_STRING_NAME);
	$NMU$TEXT (PTR,
		   40,
		   '%O,%O',
		   .T1 <18,18,0>,
		   .T1 <0,18,0>)
    end;
%fi
%global_routine ('USER_NAME', TSB : ref TEXT_STATE_BLOCK) : novalue =

!++
! Functional description:
!
!	This routine outputs the current job's user name
!	into the text output buffer.
!
! Formal parameters:
!
!	.TSB	Text state block address
!
! Routine value: none
! Side effects: none
!
!--

    begin

  %if $TOPS20 %then
    DECLARE_JSYS (GJINF, DIRST)
  %fi

    bind routine
	CHAR_OUT = .TSB [OUTPUT_ROUTINE];

    %if $TOPS20 %then
    local
        USER_NUMBER,
	PTR,
	CHAR,
	NAME_BUFFER : vector [ch$allocation (40)];

    PTR = ch$ptr (NAME_BUFFER);

    $$GJINF (;USER_NUMBER);
    $$DIRST (.PTR, .USER_NUMBER);
    %fi

    %if $TOPS10 %then
    local
	CHAR,
	PTR;

    external
	USER_STRING_NAME : vector [ch$allocation (13)];

    PTR = ch$ptr (USER_STRING_NAME);
    %fi

    while (CHAR = ch$rchar_a (PTR)) neq 0
    do CHAR_OUT (.TSB, .CHAR);

    end;					! End of USER_NAME
%routine ('JOBNUM') =

!++
! Functional description:
!
!	This routine returns the current job's job number.
!
! Formal parameters: none
!
! Routine value:
!
!	Job number.
!
! Side effects: none
!
!--

    begin

    %if $TOPS20 %then
    DECLARE_JSYS (GJINF)

    local
         JOB_NUMBER;

    $$GJINF (;,,JOB_NUMBER);

    .JOB_NUMBER
    %fi

    %if $TOPS10 %then
    register
	T1;

    UUO (0, PJOB (T1));
    .T1
    %fi

    end;			! End of JOBNUM
%if $TOPS10 %then
%routine ('SET_IPCF_INTERRUPT', CHANNEL) : novalue =

!++
! Functional description:
!
!	This routine enables trapping for IPCF packet receives.
!
! Formal parameters:
!
!	CHANNEL		The channel number for this type of interrupt
!
! Routine value:
!
!	None.
!
! Side effects:
!
!	The job will now be interrupted when a packet is put into the IPCF
!	 receive queue.
!
!--

    begin

    register
	T1;

    local
	ARGBLK : vector [3];

    ARGBLK [0] = $PCIPC;
    ARGBLK [1] = (.CHANNEL * 4) ^ 18;
    ARGBLK [2] = 0;

    T1 = PS$FAC + ARGBLK;

    UUO (1, PISYS$ (T1));

    end;					! End of SET_IPCF_INTERRUPT
    %fi

end						! End of module NMU$IPCF

eludom