Google
 

Trailing-Edge - PDP-10 Archives - BB-X117B-SB_1986 - 10,7/nml/nmudlx.b36
There is 1 other file named nmudlx.b36 in the archive. Click here to see a list.
! UPD ID= 215, SNARK:<6.1.NML>NMUDLX.B36.11,  12-Dec-84 18:43:33 by HALPIN
! Move Check for Usage types DLX_LOAD and DLX_DUMP from NMU$CIRCUIT_OPEN
! to GET_CIRCUIT_BLOCK. Also check for DEVTYP_NI and only convert to
! DLX_LDA if it is an NI.  DTE's need separate Usages for Load and Dump.
!
! UPD ID= 188, SNARK:<6.1.NML>NMUDLX.B36.10,  10-Dec-84 14:38:09 by HALPIN
! Get MONSYM Library file out of default directory, not BLI:
!
! UPD ID= 185, SNARK:<6.1.NML>NMUDLX.B36.9,   7-Dec-84 09:30:39 by HALPIN
! MATCH_CIRCUIT_ID matches on CIRCUIT_ID string and the contents
! of the USAGE fields.  This is to implement the allocation of different
! Circuit Blocks for different types of service requests.  It will
! prevent the NI Data Link watcher from being stepped on by TRIGGER,
! LOAD, and DUMP requests.
! Add PSI Channel number arguments to NMU$DLX_OPEN.  Store them in
! the Circuit Block if Circuit type is an NI.
!
! UPD ID= 175, SNARK:<6.1.NML>NMUDLX.B36.8,  19-Nov-84 10:32:43 by HALPIN
! Add support for Enabling a Multicast Address on the NI.
!
! UPD ID= 162, SNARK:<6.1.NML>NMUDLX.B36.7,   9-Nov-84 14:31:22 by GUNN
! Fix NMU$DLX_DEVICE_TYPE to return device type not device number.
!
! UPD ID= 143, SNARK:<6.1.NML>NMUDLX.B36.6,  29-Oct-84 13:46:07 by GUNN
! Add routine NMU$DLX_DEVICE_TYPE to return device type value from a
! circuit id.
!
! UPD ID= 124, SNARK:<6.1.NML>NMUDLX.B36.5,   5-Oct-84 14:41:09 by HALPIN
! Change NMU$DLX_KNOWN_DEVICE call to NTMAN JSYS to use the new STATE
! Selector.
!
! UPD ID= 108, SLICE:<6.1.NML>NMUDLX.B36.4,  18-Sep-84 16:23:52 by GUNN
!
! The Ethernet Data Link interface for MOP Loopback and Remote Console
! is implemented within the Monitor for TOPS-10/20. This is so that
! multiple MOP users can have access to single portal for each of the
! MOP functions. Therefore, there is in fact no Direct Link access
! implemented here. The code is here only because it maintains the
! current structure of the code in the rest of the modules which have
! a DLX interface. For the Ethernet data link the interface here is to
! the user level MOP interface. This is provided by the LLMOP% JSYS on
! TOPS-20.
!
! Remove definition for CD_BLOCK_FIELDS and move to NMUCOM.REQ.
! Add support for KLNI.
!
! UPD ID= 28, SNARK:<6.1.NML>NMUDLX.B36.2,  24-May-84 16:10:59 by GLINDELL
module NMUDLX =

begin

!
! COPYRIGHT (C) 1981, 1984 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:	LSG DECnet Management
!
! Abstract:	This module provides direct line access for
!		circuits on KL or KS systems.
!
! Environment:	TOPS-10 version 7.02 or later
!		TOPS-20 version 6.1 or later
!
! Author:	Bill Davenport		Creation date:	23-Feb-84
!
! Modified by:
!
!--
!
! Library files
!

library
    'NMULIB';                           ! Get all required definitions

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


!
! Global routines
!

forward routine
    NMU$DLX_ROUTINES,
    GET_CIRCUIT_BLOCK,
    PARSE_CIRCUIT_ID,
    FIND_DEVICE_TYPE,
    ASCII$DECIMAL_TO_BINARY,
    BUILD_CIRCUIT_ID,
    MATCH_CIRCUIT_ID;


!
! External references
!

external routine
    NMU$KLNI_ROUTINES,
    NMU$DTE_ROUTINES,
    NMU$TEXT,
    NMU$QUEUE_MANAGER,
    NMU$PAGE_ALLOCATOR,
    NMU$SCHED_MANAGER,
    NMU$MEMORY_MANAGER;
!
! Macros
!

macro
    DEVICE_SET =
	 0, 'DP',		! DP11-DA (Obsolete)
	 1, 'UNA',		! DEUNA
	 2, 'DU',		! DU11-DA
	 3, 'CNA',		!
	 4, 'DL',		! DL11-C, -E, or -WA
	 5, 'QNA',		!
	 6, 'DQ',		! DQ11-DA (Obsolete)
	 7, 'CI',		! CI
	 8, 'DA',		! DA11-B or -AL
	 9, 'PCL',		! PCL11-B
	10, 'DUP',		! DUP11-DA
	12, 'DMC',		! DMC11-DA/AR, -FA/AR, -MA/AL or -MD/AL
	14, 'DN',		! DN11-BA or -AA
        15, 'KLNI',             ! TOPS-10/20 Ethernet (NIA-20)
        15, 'ETH',              ! TOPS-10 Ethernet (NIA-20)
        15, 'NI',               ! TOPS-20 Ethernet (NIA-20)
	16, 'DLV',		! DLV11-E, -F, -J, MXV11-A or -B
	18, 'DMP',		! DMP11
	20, 'DTE',		! DTE20
	22, 'DV',		! DV11-AA/BA
	24, 'DZ',		! DZ11-A, -B, -C, or -D
	28, 'KDP',		! KMC11/DUP11-DA
	30, 'KDZ',		! KMC11/DZ11-A, -B, -C, or -D
	32, 'KL',		! KL8-J (Obsolete)
	34, 'DMV',		! DMV11
	36, 'DPV',		! DPV11
	38, 'DMF',		! DMF-32
	40, 'DMR',		! DMR11-AA, -AB, -AC, or -AE
	42, 'KMY',		! KMS11-PX
	44, 'KMX' %;		! KMS11-BD/BE

macro
    ASSIGN_DEVICE_TYPES (CODE, NAME) [] =
		literal %name ('DEVTYP_', NAME) = CODE;
		ASSIGN_DEVICE_TYPES (%remaining) %;

ASSIGN_DEVICE_TYPES (DEVICE_SET)

macro 
    COUNT_ARGUMENTS (ARGS) [] = +1
		COUNT_ARGUMENTS (%remaining) %;

literal
    KNOWN_DEVICE_COUNT = (COUNT_ARGUMENTS (DEVICE_SET))/2;
!
! Own storage
!

macro
    DEVICE_CODES_LIST [CODE, NAME] = CODE %;

own
    DEVICE_CODES:	vector [KNOWN_DEVICE_COUNT]
			initial (DEVICE_CODES_LIST (DEVICE_SET))
			psect ($high$);

macro
    DEVICE_NAMES_LIST [CODE, NAME] = ch$ascic (NAME) %;

own
    DEVICE_NAMES:	vector [KNOWN_DEVICE_COUNT]
			initial (DEVICE_NAMES_LIST (DEVICE_SET))
			psect ($high$);

own
    CIRCUIT_QUEUE_HEADER:	Q_HEADER;
%global_routine ('NMU$DLX_INITIALIZE'): novalue =

!++
! Functional description:
!
!	This routine is used to initialize the NMUDLX data base
!	at NML startup time.
!
!--

begin

    NMU$QUEUE_RESET (CIRCUIT_QUEUE_HEADER);

end;				! of NMU$DLX_INITIALIZE
%global_routine ('NMU$DLX_OPEN', USAGE, CIRCUIT_ID, PHY_ADDR, RSP_POINTER) =

!++
! Functional description:
!
!        This routine opens a link in MOP mode.  The link is
!        conditioned to operate properly depending on the
!        use that the link will be put to.
!
! Formal parameters:
!
!	.USAGE			Type of usage for the link.
!				    (DLX_LOAD, DLX_DUMP, or DLX_LOOP)
!	.CIRCUIT_ID		Pointer to counted ASCII identifier string
!       .PHY_ADDR               Pointer to node's physical address
!	.RSP_POINTER		Pointer to NICE response buffer 
!
! Routine value:
!
!	<0			Error occured while opening link
!	>=0			Link identifier (for future reference)
!
!--

begin

    local
	CD: ref CD_BLOCK;	! Pointer to circuit data block


    !
    ! Check for a valid circuit and get it's circuit data block
    !

    if not GET_CIRCUIT_BLOCK (.CIRCUIT_ID, CD, .USAGE, .RSP_POINTER)
    then
	return -1;


    selectone .CD [CD_TYPE] of
    set

	[DEVTYP_DTE]:
	    if not NMU$DTE_OPEN (.CD, .RSP_POINTER)
	    then
		return -1;

        [DEVTYP_KLNI]:
            begin

            CD [CD_KLNI_PHYADR] = .PHY_ADDR;

            if .USAGE eql DLX_LOAD or .USAGE eql DLX_DUMP
            then return .CD;

	    if not NMU$KLNI_OPEN (.CD, .RSP_POINTER)
	    then
		return -1;
            end;

	[otherwise]:
	    begin
		$RESPONSE (.RSP_POINTER, NICE$_OPF, 0,
			   'Function not supported for device %X',
			   DEVICE_NAMES [.CD [CD_TYPE]]);
		return -1;
	    end;

    tes;

    .CD

end;				! of NMU$DLX_OPEN
%global_routine ('NMU$DLX_CLOSE', CD: ref CD_BLOCK) =

!++
! Functional description:
!
!	This routine releases the specified circuit from
!	use by Network Management.
!
! Formal parameters:
!
!	.CD			Identifier for circuit
!
! Routine value:
!
!	$true			Successful
!	$false			Error during close
!
!--

begin

    selectone .CD [CD_TYPE] of
    set

	[DEVTYP_DTE]:
	    if not NMU$DTE_CLOSE (.CD) then return $false;

        [DEVTYP_KLNI]:
	    if not NMU$KLNI_CLOSE (.CD) then return $false;

	[otherwise]:
	    TASK_ERROR ('NMU$DLX_CLOSE called with invalid device');

    tes;

!+
!    NMU$QUEUE_EXTRACT (CIRCUIT_QUEUE_HEADER, .CD);
!
!    NMU$MEMORY_RELEASE (.CD, CD_BLOCK_SIZE);
!-
    $false

end;				! of NMU$DLX_CLOSE
%global_routine ('NMU$DLX_READ', CD: ref CD_BLOCK, USAGE, PTR, LEN, RSP_POINTER) =

!++
! Functional description:
!
!        This routine reads a maintenance message from the specified
!        circuit.
!
! Formal parameters:
!
!	.CD			Identifier for circuit
!	.USAGE			What type of read is supposed to be done
!				    (DLX_DATA for MOP data)
!	.PTR			Pointer to message buffer
!	.LEN			Number of bytes in message buffer to write
!	.RSP_POINTER		Pointer to NICE response buffer
!
! Routine value:
!
!        Number of bytes read on circuit
!
!		or
!
!	-2 for read timeout
!	-1 for any other error
!
!--

begin

    selectone .CD [CD_TYPE] of
    set

	[DEVTYP_DTE]:
	    return NMU$DTE_READ (.CD, .USAGE, .PTR, .LEN, .RSP_POINTER);

        [DEVTYP_KLNI]:
            return NMU$KLNI_READ (.CD, .USAGE, .PTR, .LEN, .RSP_POINTER);

	[otherwise]:
	    TASK_ERROR ('NMU$DLX_READ called with invalid device');

    tes;

    return -1

end;				! of NMU$DLX_READ
%global_routine ('NMU$DLX_WRITE', CD: ref CD_BLOCK, USAGE, PTR, LEN, RSP_POINTER) =

!++
! Functional description:
!
!	This routine sends a maintenance message across the specified
!	circuit.
!
! Formal parameters:
!
!	.CD			Identifier for circuit
!	.USAGE			What type of write is being done
!				    (DLX_SECONDARY to load secondary loader,
!				     DLX_DATA to send MOP data message)
!	.PTR			Pointer to message buffer
!	.LEN			Number of bytes in message buffer to write
!	.RSP_POINTER		Pointer to NICE response buffer
!
! Routine value:
!
!	$true			Write succeeded
!	$false			Failure during write
!
!--

begin

    selectone .CD [CD_TYPE] of
    set

	[DEVTYP_DTE]:
	    return NMU$DTE_WRITE (.CD, .USAGE, .PTR, .LEN, .RSP_POINTER);

        [DEVTYP_KLNI]:
            return NMU$KLNI_WRITE (.CD, .USAGE, .PTR, .LEN, .RSP_POINTER);

	[otherwise]:
	    TASK_ERROR ('NMU$DLX_WRITE called with invalid device');

    tes;

    $false

end;				! of NMU$DLX_WRITE
%global_routine ('NMU$DLX_START_PROTOCOL', CD: ref CD_BLOCK, RSP_POINTER) =

!++
! Functional description:
!
!	This routine is responsible for initializing protocol on
!	those devices which require that service.
!
! Formal parameters:
!
!	.CD			Identifier for circuit
!	.RSP_POINTER		Pointer to NICE response buffer
!
! Routine value:
!
!	$true			If protocol initialized successfully
!				 (or if function not needed for device)
!	$false			If error initializing protocol
!
!--

begin

    selectone .CD [CD_TYPE] of
    set

	[DEVTYP_DTE]:
	    return NMU$DTE_START_PROTOCOL (.CD, .RSP_POINTER);

    tes;

    $true

end;				! of NMU$DLX_START_PROTOCOL
%global_routine ('NMU$DLX_STOP_PROTOCOL', CD: ref CD_BLOCK, RSP_POINTER) =

!++
! Functional description:
!
!	This routine is responsible for clearing protocol on
!	those devices which require that service.
!
! Formal parameters:
!
!	.CD			Identifier for circuit
!	.RSP_POINTER		Pointer to NICE response buffer
!
! Routine value:
!
!	$true			If protocol cleared successfully
!				 (or if function not needed for device)
!	$false			If error clearing protocol
!
!--

begin

    selectone .CD [CD_TYPE] of
    set

	[DEVTYP_DTE]:
	    return NMU$DTE_STOP_PROTOCOL (.CD, .RSP_POINTER);

    tes;

    $true

end;				! of NMU$DLX_STOP_PROTOCOL
%global_routine ('NMU$DLX_KNOWN_DEVICE', CIRCUIT_ID) =

!++
! Functional description:
!
!	This routine is responsible for checking whether or
!	not a particular circuit is known by the system.
!
! Formal parameters:
!
!	.CIRCUIT_ID		Pointer to ASCIC circuit id
!
! Routine value:
!
!	$true			If circuit is known by system
!	$false			If circuit is unknown
!
!--

begin

    literal
	$NTMAX = 9,			! NTMAN block length
	BUFLEN = 20;			! Size of data buffer


    local
	NTMAN_BLOCK: vector [$NTMAX],	! NTMAN argument block
	NTMAN_BUFFER: vector [BUFLEN];	! NTMAN data buffer

    NTMAN_BLOCK [$NTCNT] = $NTMAX;
    NTMAN_BLOCK [$NTENT] = $NTCKT;
    NTMAN_BLOCK [$NTEID] = .CIRCUIT_ID;
    NTMAN_BLOCK [$NTFNC] = $NTSHO;
    NTMAN_BLOCK [$NTSEL] = $NTSUM;
    NTMAN_BLOCK [$NTQUA] = 0;
    NTMAN_BLOCK [$NTBPT] = ch$ptr (NTMAN_BUFFER,,8);
    NTMAN_BLOCK [$NTBYT] = 4*BUFLEN-1;
    NTMAN_BLOCK [$NTERR] = 0;

    begin
	%if $TOPS10
	%then
	    builtin UUO;
	    register T1;
	    T1 = NTMAN_BLOCK;
	    UUO (1, NTMAN$ (T1));
	%fi
	%if $TOPS20
	%then
	    builtin JSYS;
	    register T1 = 1;
            T1 = NTMAN_BLOCK;
	    JSYS (-1, NTMAN_, T1);
	%fi
    end;

    if (.NTMAN_BLOCK [$NTERR] eql NICE$_SUC)
        or
       (.NTMAN_BLOCK [$NTERR] eql NICE$_REE)
    then
	return $true;

    $false

end;				! of NMU$DLX_KNOWN_DEVICE
%global_routine ('NMU$DLX_FRONT_END_DEVICE', CIRCUIT_ID) =

!++
! Functional description:
!
!	This routine is used to check if a specific circuit is
!	to a front end of the system.
!
! Formal parameters:
!
!	.CIRCUIT_ID		Pointer to ASCIC circuit id
!
! Routine value:
!
!	$true			Circuit is to a front end
!	$false			Circuit isn't to a front end
!
!--

begin

    local
	TYPE,			! Device type from PARSE_CIRCUIT_ID
	CONTROLLER,		! Controller number from PARSE_CIRCUIT_ID
	DEVICE,			! Device number from PARSE_CIRCUIT_ID
	STATION,		! Station number from PARSE_CIRCUIT_ID
	RSP_DUMMY: vector [10];	! Dummy NICE response buffer

    !
    ! First check for a valid format circuit id, and
    ! break into its constituent parts
    !

    if not PARSE_CIRCUIT_ID (.CIRCUIT_ID, TYPE, CONTROLLER,
			     DEVICE, STATION, ch$ptr (RSP_DUMMY,,8))
    then
	return $false;

    selectone .TYPE of
    set

	[DEVTYP_DTE]:
	    return $true;

    tes;

    $false

end;				! of NMU$DLX_FRONT_END_DEVICE
%global_routine ('NMU$DLX_DEVICE_TYPE', CIRCUIT_ID) =

!++
! Functional description:
!
!	This routine returns the generic device type for a
!       specific circuit if known to the system.
!
! Formal parameters:
!
!	.CIRCUIT_ID		Pointer to ASCIC circuit id
!
! Routine value:
!
!	Device Type value	If Circuit exists
!	-1			If Circuit is invalid or nonexistant
!
!--

begin

    local
	TYPE,			! Device type from PARSE_CIRCUIT_ID
	CONTROLLER,		! Controller number from PARSE_CIRCUIT_ID
	DEVICE,			! Device number from PARSE_CIRCUIT_ID
	STATION,		! Station number from PARSE_CIRCUIT_ID
	RSP_DUMMY: vector [10];	! Dummy NICE response buffer

    !
    ! First check for a valid format circuit id, and
    ! break into its constituent parts
    !

    if PARSE_CIRCUIT_ID (.CIRCUIT_ID, TYPE, CONTROLLER,
			     DEVICE, STATION, ch$ptr (RSP_DUMMY,,8))
    then
        return .TYPE
    else
	return -1;

end;				! of NMU$DLX_DEVICE_TYPE
%global_routine ('NMU$DLX_ENABLE_MULTICAST', CD : ref CD_BLOCK, RSP_POINTER) =

!++
! Functional description:
!
!     This routine calls NMU$KLNI_ENABLE_MULTICAST to enable
!     the Load/Dump Multicast Address on the KLNI.  It is
!     called from the NI Data Link Watcher Task.
!
! Formal Parameters:
!
!     .CD           Identifier for the circuit
!     .RSP_POINTER  Pointer to the NICE response buffer
!
! Routine value:
!
!     $true         If Multicast Address is enabled successfully
!
!     $false        If an error occured.
!
!--
begin

     selectone .CD [CD_TYPE] of
     set

        [DEVTYP_KLNI]:
                 return NMU$KLNI_ENABLE_MULTICAST (.CD, .RSP_POINTER);

     tes;

     $true

end;                  ! of NMU$DLX_ENABLE_MULTICAST


%routine ('GET_CIRCUIT_BLOCK', CIRCUIT_ID, CD_PTR, USAGE, RSP_POINTER) =

!++
! Functional description:
!
!	This routine is responsible for checking the validity of
!	a circuit id and returning the circuit block corresponding
!	to that circuit.  If a circuit block doesn't yet exist,
!	one is created.
!
! Formal parameters:
!
!	.CIRCUIT_ID		Pointer to ASCIC circuit id string
!	.CD_PTR			Address of circuit block pointer
!       .USAGE                  Usage of the circuit (DLX_LOAD,DLX_TRIGGER,...)
!	.RSP_POINTER		Pointer to NICE response buffer
!
! Routine value:
!
!	$true			Valid circuit id
!	$false			Invalid circuit id
!
! Side effects:
!
!	A newly created circuit id is linked into the list of
!	already existing circuit ids.
!
!--

begin

    bind
	CD = (.CD_PTR): ref CD_BLOCK;

    local
        CKT_ID_AND_USAGE : vector [2],
	TYPE,			! Device type from PARSE_CIRCUIT_ID
	CONTROLLER,		! Controller number from PARSE_CIRCUIT_ID
	DEVICE,			! Device number from PARSE_CIRCUIT_ID
	STATION;		! Station number from PARSE_CIRCUIT_ID

    !
    ! First check for a valid format circuit id, and
    ! break into its constituent parts
    !

    if not PARSE_CIRCUIT_ID (.CIRCUIT_ID, TYPE, CONTROLLER,
			     DEVICE, STATION, .RSP_POINTER)
    then
	return $false;

    !
    ! Make sure that this circuit is known by the system
    !

    if not NMU$DLX_KNOWN_DEVICE (.CIRCUIT_ID)
    then
	begin
	    $RESPONSE (.RSP_POINTER, NICE$_IID, 0,
		       'Unrecognized device %X',
		       .CIRCUIT_ID);
	    return $false;
	end;

    !
    ! LOAD and DUMP requestson the KLNI use the LOAD/DUMP ASSISTANCE circuit
    ! block.
    !

    if ((.USAGE eql DLX_LOAD or .USAGE eql DLX_DUMP) and
        (.TYPE eql DEVTYP_KLNI))
    then USAGE = DLX_LDA;


    !
    ! Try to locate this circuit in the list of circuit data blocks
    !

    CKT_ID_AND_USAGE [0] = .CIRCUIT_ID;
    CKT_ID_AND_USAGE [1] = .USAGE;

    if (CD = NMU$QUEUE_SCAN (CIRCUIT_QUEUE_HEADER,
			     CKT_ID_AND_USAGE,
			     MATCH_CIRCUIT_ID)) neqa 0
    then
	return $true;

    !
    ! Create a new circuit data block for this circuit id
    !

    if (CD = NMU$MEMORY_GET (CD_BLOCK_SIZE)) eqla 0
    then
	TASK_ERROR ('Can''t allocate circuit data block');

    ch$move (ch$rchar (.CIRCUIT_ID) + 1, .CIRCUIT_ID,
	     ch$ptr (CD [CD_NAME],,8));
    CD [CD_TYPE] = .TYPE;
    CD [CD_CONTROLLER] = .CONTROLLER;
    CD [CD_DEVICE] = .DEVICE;
    CD [CD_STATION] = .STATION;
    CD [CD_USAGE] = .USAGE;

    NMU$QUEUE_INSERT (CIRCUIT_QUEUE_HEADER, .CD);

    return $true;

end;				! of GET_CIRCUIT_ID
%routine ('PARSE_CIRCUIT_ID', INPUT, TYPE, CONTROLLER, DEVICE,
			      STATION, RSP_POINTER) =

!++
! Functional description:
!
!	This routine breaks an ASCII string of the form XXX-CC-DD.S
!	into:
!		XXX	Device type
!		CC	Controller number
!		DD	Device number (on controller)
!		S	Multipoint station number
!
! Formal parameters:
!
!	.INPUT			Byte pointer to counted ASCII id string
!	.TYPE			Device type
!	.CONTROLLER		Controller number
!	.DEVICE			Device number
!	.STATION		Station number
!	.RSP_POINTER		Byte pointer to NICE response buffer
!
! Routine value:
!
!	$true			Identifier parsed correctly
!	$false			Identifier failed to parse
!				 (error in response buffer)
!
!--

begin

    local
	LENGTH,
        POINTER;

    POINTER = .INPUT;

    !
    ! Get the number of bytes in the id.
    !

    if (LENGTH = ch$rchar_a (POINTER)) leq 0
    then
	begin
	    $RESPONSE (.RSP_POINTER, NICE$_IID, CIRCUIT_,
		       'Zero length identifier');
	    return $false;
	end;

    !
    ! Determine the circuit type
    !

    if (.TYPE = FIND_DEVICE_TYPE (LENGTH, POINTER)) lss 0
    then
	begin
	    $RESPONSE (.RSP_POINTER, NICE$_IID, CIRCUIT_,
		       'Invalid device type');
	    return $false;
	end;

    !
    ! Check for device type only
    !

    if .LENGTH leq 0
    then
	begin
	    $RESPONSE (.RSP_POINTER, NICE$_IID, CIRCUIT_,
		       'Controller or device number not specified');
	    return $false;
	end;

    !
    ! Check for '-' field separator
    !

    if ch$rchar_a (POINTER) neq %C'-'
    then
	begin
	    $RESPONSE (.RSP_POINTER, NICE$_IID, CIRCUIT_,
		       'Illegal separator after device type');
	    return $false;
	end;

    LENGTH = .LENGTH - 1;

    !
    ! Read controller number
    !

    if not ASCII$DECIMAL_TO_BINARY (LENGTH, POINTER, .CONTROLLER)
    then
	begin
	    $RESPONSE (.RSP_POINTER, NICE$_IID, CIRCUIT_,
		       'Illegal controller number');
	    return $false;
	end;

    if .LENGTH leq 0
    then
	begin
	    .DEVICE = -1;
	    .STATION = -1;
	    return $true;
	end;

    !
    ! Check for '-' field separator
    !

    if ch$rchar_a (POINTER) neq %C'-'
    then
	begin
	    $RESPONSE (.RSP_POINTER, NICE$_IID, CIRCUIT_,
		       'Illegal separator after controller');
	    return $false;
	end;

    LENGTH = .LENGTH - 1;

    !
    ! Read device number
    !

    if not ASCII$DECIMAL_TO_BINARY (LENGTH, POINTER, .DEVICE)
    then
	begin
	    $RESPONSE (.RSP_POINTER, NICE$_IID, CIRCUIT_,
		       'Illegal device number');
	    return $false;
	end;

    if .LENGTH leq 0
    then
	begin
	    .STATION = -1;
	    return $true;
	end;

    !
    ! Check for '.' field separator
    !

    if ch$rchar_a (POINTER) neq %C'.'
    then
	begin
	    $RESPONSE (.RSP_POINTER, NICE$_IID, CIRCUIT_,
		       'Illegal separator after device');
	    return $false;
	end;

    LENGTH = .LENGTH - 1;

    !
    ! Read station number
    !

    if not ASCII$DECIMAL_TO_BINARY (LENGTH, POINTER, .STATION)
    then
	begin
	    $RESPONSE (.RSP_POINTER, NICE$_IID, CIRCUIT_,
		       'Illegal station number');
	    return $false;
	end;

    if .LENGTH leq 0
    then
	return $true;

    !
    ! If more remains in the input string, then
    ! there is an error
    !

    $RESPONSE (.RSP_POINTER, NICE$_IID, CIRCUIT_,
               'Garbage at end of id');
    $false

end;				! of PARSE_CIRCUIT_ID
%routine ('FIND_DEVICE_TYPE', LENGTH, POINTER) =

!++
! Functional description:
!
!	This routine compares the device name pointed by
!	the calling arguments against the set of names in
!	the DEVICE_NAMES vector.  If it is found the associated
!	device code from the DEVICE_CODES vector is returned.
!
! Formal parameters:
!
!	.LENGTH			Input string length
!	.POINTER		Input string pointer
!
! Routine value:
!
!	-1			If no match is made against the device name
!	>=0			Device code
!
!--

begin

    local
	NAME_LENGTH,
	START_POINTER,
	DEV_POINTER,
	DEV_LENGTH;


    START_POINTER = ..POINTER;

    if ch$fail (.POINTER = ch$find_ch (..LENGTH, .START_POINTER, %C'-'))
    then
	NAME_LENGTH = ..LENGTH
    else
	NAME_LENGTH = ch$diff (..POINTER, .START_POINTER);

    incr INDEX from 0 to KNOWN_DEVICE_COUNT - 1
    do
	begin
	    DEV_POINTER = ch$plus (.DEVICE_NAMES [.INDEX], -1);
	    DEV_LENGTH = ch$rchar_a (DEV_POINTER);

	    if ch$eql (.NAME_LENGTH, .START_POINTER, .DEV_LENGTH, .DEV_POINTER)
	    then
		begin
		    .LENGTH = ..LENGTH - .NAME_LENGTH;
		    return .DEVICE_CODES [.INDEX];
		end;
	end;
                                
    -1

end;				! of FIND_DEVICE_TYPE
%routine ('ASCII$DECIMAL_TO_BINARY', LENGTH, POINTER, VALUE) =

!++
! Functional description:
!
!	This routine converts a decimal ASCII string into binary
!	value.
!
! Formal parameters:
!
!	.LENGTH			Input string length
!	.POINTER		Input string pointer
!	.VALUE			Resulting value of conversion
!
! Routine value:
!
!	$true			A number was converted
!	$false			No number converted for either:
!				- No characters in input stream (zero length)
!				- First character read was non-numeric
!
!--

begin

    local
	CONVERT,
	CHAR;

    .VALUE = 0;
    CONVERT = $false;

    while ..LENGTH gtr 0
    do
	begin
	    CHAR = ch$rchar_a (.POINTER);

	    if (.CHAR geq %C'0') and (.CHAR leq %C'9')
	    then
		begin
		    CONVERT = $true;
		    .VALUE = (..VALUE * 10) + (.CHAR - %C'0');
		end
	    else
		begin
		    .POINTER = ch$plus (..POINTER, -1);
		    return .CONVERT;
		end;
	    .LENGTH = ..LENGTH - 1;
	end;

    .CONVERT

end;				! of ASCII$DECIMAL_TO_BINARY
%routine ('BUILD_CIRCUIT_ID', OUTPUT, LIMIT, TYPE, CONTROLLER, DEVICE, STATION, RESPONSE_POINTER) =

!++
! Functional description:
!
!	This routine builds a identifier string from the device type,
!	controller number, device number and station number.  The first
!       byte in the string will be the count of the remaining bytes
!       (i.e. a counted string).
!
! Formal parameters:
!
!	.OUTPUT            Address of pointer to the output string buffer
!       .LIMIT             Maximum number of characters in identifier
!       .TYPE              Device type code
!       .CONTROLLER        Controller number
!       .DEVICE            Device number (on controller)
!       .STATION           Multipoint station number
!       .RESPONSE_POINTER  Byte pointer to NICE response buffer
!
! Implicit inputs: none
! Implicit outputs: none
!
! Routine value:
!
!       $true      Identifier converted properly
!       $false     Conversion failed because of:
!                  - Output buffer too small
!                  - Unknown device type
!                  - Invalid controller number (lss 0)
!                  - Station number without device number
!
! Side effects: none
!
!--

    begin

    local
         COUNT,
         FIELD_COUNT,
         START_OUTPUT,
         OFFSET,
         DEV_POINTER,
         DEV_LENGTH;

!
! Start with no characters in output string and save
! where the string starts.
!
    COUNT = 0;
    START_OUTPUT = ..OUTPUT;
    .OUTPUT = ch$plus (..OUTPUT, 1);
!
! Search for the device type and get a pointer to
! the device name.
!
    OFFSET = -1;

    incr INDEX from 0 to KNOWN_DEVICE_COUNT - 1
    do
      if .DEVICE_CODES [.INDEX] eql .TYPE
      then
          begin
          OFFSET = .INDEX;
          exitloop;
          end;

    if .OFFSET eql -1
    then
        begin
        if .RESPONSE_POINTER neqa 0
        then
            $RESPONSE (.RESPONSE_POINTER, NICE$_IID, CIRCUIT_,
                       'Unknown device type, building circuit id');
        return $false;
        end;

    DEV_POINTER = ch$ptr (.DEVICE_NAMES [.OFFSET]);
    DEV_LENGTH = ch$rchar_a (DEV_POINTER);
!
! Copy the device name into the output buffer
!
    if (COUNT = $NMU$TEXT (.OUTPUT, .LIMIT, '%#A%N',
                           .DEV_LENGTH, .DEV_POINTER)) lss 0
    then
        begin
        if .RESPONSE_POINTER neqa 0
        then
            $RESPONSE (.RESPONSE_POINTER, NICE$_OPF, 0,
                       'Text error generating device name');
        return $false;
        end;
!
! Check for a valid controller and output it
! to the identifier string if it's ok.
!
    if .CONTROLLER lss 0
    then
        begin
        if .RESPONSE_POINTER neqa 0
        then
            $RESPONSE (.RESPONSE_POINTER, NICE$_IID, CIRCUIT_,
                       'No controller specified, building circuit id');
        return $false;
        end;

    if (FIELD_COUNT = $NMU$TEXT (.OUTPUT, (.LIMIT - .COUNT), '_%D%N',
                                 .CONTROLLER)) lss 0
    then
        begin
        if .RESPONSE_POINTER neqa 0
        then
            $RESPONSE (.RESPONSE_POINTER, NICE$_OPF, 0,
                       'Text error generating controller number');
        return $false;
        end;

    COUNT = .COUNT + .FIELD_COUNT;
!
! Check for a valid device number and output it
! to the identifier string.  If no device number
! is available, check to see if a station number
! has been supplied in error.
!
    if .DEVICE lss 0
    then
        if .STATION lss 0
        then
            begin
            ch$wchar_a (.COUNT, START_OUTPUT);
            return $true;
            end
        else
            begin
            if .RESPONSE_POINTER neqa 0
            then
                $RESPONSE (.RESPONSE_POINTER, NICE$_IID, CIRCUIT_,
                           'Station number supplied without device number');
            return $false;
            end;

    if (FIELD_COUNT = $NMU$TEXT (.OUTPUT, (.LIMIT - .COUNT), '_%D%N',
                                 .DEVICE)) lss 0
    then
        begin
        if .RESPONSE_POINTER neqa 0
        then
            $RESPONSE (.RESPONSE_POINTER, NICE$_OPF, 0,
                       'Text error generating device number');
        return $false;
        end;

    COUNT = .COUNT + .FIELD_COUNT;
!
! Check for a valid station number.  Output it
! to the identifier string if specified.
!
    if .STATION lss 0
    then
        begin
        ch$wchar_a (.COUNT, START_OUTPUT);
        return $true;
        end;

    if (FIELD_COUNT = $NMU$TEXT (.OUTPUT, (.LIMIT - .COUNT), '.%D%N',
                                 .STATION)) lss 0
    then
        begin
        if .RESPONSE_POINTER neqa 0
        then
            $RESPONSE (.RESPONSE_POINTER, NICE$_OPF, 0,
                       'Text error generating station number');
        return $false;
        end;
!
! Indicate that the identifier has been properly constructed.
!

    ch$wchar_a ((.COUNT + .FIELD_COUNT), START_OUTPUT);
    $true

    end;					! End of BUILD_CIRCUIT_ID

%routine ('MATCH_CIRCUIT_ID', CD: ref CD_BLOCK, CKT_ID_USAGE : ref vector [2]) =

!++
!
! Functional description:
!
!	This routine facilitates the search for a circuit block with
!	the same name as CIRCUIT_ID.
!
! Formal parameters:
!
!	.CD			Pointer to circuit block
!	.CKT_ID_USAGE           A two word vector containing a pointer
!                               to an ASCIC Circuit Id in the first location
!                               and a Usage code (DLX_TRIGGER, ect...) in
!                               the second location.
!
! Routine value:
!
!	0			CIRCUIT_ID does not match
!	>0			Address of circuit block which matches
!
!--

begin

    bind
        CIRCUIT_ID = CKT_ID_USAGE [0],
        CIRCUIT_USAGE = CKT_ID_USAGE [1],
	CD_PTR = ch$ptr (CD [CD_NAME],, 8),
	CD_LEN = ch$rchar (CD_PTR);

    if ch$eql (CD_LEN + 1,
	       CD_PTR,
	       ch$rchar (.CIRCUIT_ID) + 1,
	       .CIRCUIT_ID,
	       0)
    then
        if .CD [CD_USAGE] eql .CIRCUIT_USAGE
	then return .CD
        else return 0
    else
	return 0;

end;				! of MATCH_CIRCUIT_ID
end				! of module NMUDLX
eludom