Trailing-Edge
-
PDP-10 Archives
-
BB-P363B-SM_1985
-
t20/nmlt20/ncpcex.b36
There is 1 other file named ncpcex.b36 in the archive. Click here to see a list.
! UPD ID= 340, SNARK:<6.1.NML>NCPCEX.B36.16, 15-Aug-85 12:58:55 by MCCOLLUM
! Use the value returned by QUOTE_FIELD to update the length of the
! password, account, or user name strings. This will allow quoted characters
! to appear in these strings.
!
! UPD ID= 323, SNARK:<6.1.NML>NCPCEX.B36.15, 8-May-85 21:36:50 by GLINDELL
! Allow dashes in ETHERNET addresses (HI and H formats). Add REMOVE_DASHES.
!
! UPD ID= 313, SNARK:<6.1.NML>NCPCEX.B36.10, 6-May-85 21:47:09 by GLINDELL
! Reinstate $KNSIG since SIGNIFICANT is back, but invisible in NCPTAB.
!
! UPD ID= 309, SNARK:<6.1.NML>NCPCEX.B36.9, 30-Apr-85 15:57:03 by GLINDELL
! Comment out $KNSIG since SIGNIFICANT is no longer part of NCPTAB
!
! UPD ID= 303, SNARK:<6.1.NML>NCPCEX.B36.8, 29-Apr-85 18:01:07 by GLINDELL
! NCP$SEND_RESPONSE has an extra argument - add that to all calls
!
! UPD ID= 262, SNARK:<6.1.NML>NCPCEX.B36.7, 1-Mar-85 09:59:54 by GLINDELL
! 1. TELL area.node used the area # for node number and ignored node #!
! - dot bugs in NCP$TELL.
! 2. Fixes for area typeout in SHOW QUEUE code.
!
! UPD ID= 199, SNARK:<6.1.NML>NCPCEX.B36.6, 10-Dec-84 15:05:57 by HALPIN
! Get MONSYM Library file out of default directory, not BLI:
!
! UPD ID= 168, SNARK:<6.1.NML>NCPCEX.B36.5, 15-Nov-84 13:40:35 by HALPIN
! Add Area.Node_Nmuber support in NCP$TELL.
!
! UPD ID= 79, SLICE:<6.1.NML>NCPCEX.B36.4, 18-Sep-84 14:48:33 by GUNN
! WORK:<GUNN.NML>NCPCEX.B36.2 21-Aug-84 12:00:54, 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= 52, SNARK:<6.1.NML>NCPCEX.B36.3, 6-Jun-84 11:31:07 by HALPIN
! Undeclared $TOPS10, $TOPS20, $MCB, and $X25 preceding the Require GALAXY
! statement, because GALAXY.R36, requires SYSTYP.REQ, which has already
! been invoked.
!
! UPD ID= 22, SNARK:<6.1.NML>NCPCEX.B36.2, 24-May-84 14:00:34 by GLINDELL
! DSKT:NCPCEX.B36[10,6026,NML702] 10-Feb-84 11:33:44, Edit by DAVENPORT
!
! Change NCPTAB keyword names from $DNxxx to $KNxxx to avoid conflicts
! with DNET. UUO definitions in UUOSYM.R36.
!
! PH4:<HALPIN>NCPCEX.B36.3 26-Jan-84 14:55:59, Edit by HALPIN
!
! Ident 57.
! Fix call to NML$INFORMATION in ASSEMBLER. Was calling
! with the contents of DATA in the PARAMETER field, causing
! a failure return. This resulted in the incorrect assembly
! of the NICE message for a SHOW LOGGING FILE EVENTS KNOWN SINKS
! command.
!
! DSKT:NCPCEX.B36[10,6026,NML54] 18-Jan-84 15:19:33, Edit by DAVENPORT
!
! Add back code to convert userid, account, and password to upper case
! that was lost by Edit 42. This is a short term fix until the MCB
! is changed to do this conversion on incoming account information.
!
! DSKC:NCPCEX.B36[10,5665,SOURCE,TOPS10] 22-Nov-83 15:40:08, Edit by GROSSMAN
!
! Disable the routine QUOTE_FIELD for TOPS-10 in order to prevent quoting
! characters from ending up in DECnet CI messages.
!
! PH4:<HALPIN>NCPCEX.B36.2 7-Dec-83 16:44:15, Edit by HALPIN
!
! Ident 56.
! Fix the formatting of HI-n NICE parameter value. Create a new routine
! CVATHI similar to CVATH to do it but not reversing the value string.
! From PVC:<VOBA.NML.DEVELOPMENT>NCPCEX.B36.7
!
! PH4:<GLINDELL>NCPCEX.B36.2 17-Nov-83 09:44:48, Edit by GLINDELL
!
! Ident 55.
! Make CVLTU (Convert lower to upper case) global for the use of
! other modules. In future, move this and other similar routines
! to some 'general' module.
!
!<MCINTEE.WORK>NCPCEX.B36.8, 9-Sep-83 12:10:21, Edit by MCINTEE
!
! Ident 54.
! x.y node number format support
!
!<MCINTEE.WORK>NCPCEX.B36.2, 5-Aug-83 13:13:41, Edit by MCINTEE
!
! Ident 53.
! AREA entity bug fix
!
!<MCINTEE.WORK>NCPCEX.B36.2, 26-Jul-83 14:55:45, Edit by MCINTEE
!
! Ident 52.
! Add in references to subentity type. Subentity type is needed at this
! level.
!
!<MCINTEE.WORK>NCPCEX.B36.2, 13-Jul-83 08:31:36, Edit by MCINTEE
!
! Ident 51.
! Remove all references to subentity type. All that is now
! handled in NMLNIC.
!
!<MCINTEE.WORK>NCPCEX.B36.4, 7-Jul-83 10:51:05, Edit by MCINTEE
!
! Ident 50.
! Add new module entities for phase IV
!
!<MCINTEE.WORK>NCPCEX.B36.18, 14-Jun-83 11:23:32, Edit by MCINTEE
!
! Ident 49.
! Add in AREA entity, ADJACENT_ and SIGNIFICANT_ selectors
! Change ENTITY type constant names to new style.
!
! PH4:<PECKHAM>NCPCEX.B36.13 17-May-83 13:36:20, Edit by PECKHAM
!
! Ident 48.
! Fix ASSEMBLER to use NML$DATA_TYPE to determine how to format
! the data. This also required a change in the calling sequence
! from the routine NICE_PARM to include the entity type and
! parameter number.
!
! <BRANDT.DEVELOPMENT>NCPCEX.B36.1 6-Dec-82 15:15:21, Edit by BRANDT
!
! Ident 47.
! Fix NICE_PARM and NM_PARMS so that qualifiers for EVENTS are
! included in NICE messages.
!
! <BRANDT.DEVELOPMENT>NCPCEX.B36.1 6-Dec-82 12:51:12, Edit by BRANDT
!
! Ident 46.
! In QUOTE_FIELD return the length of the new string with embedded
! ^V chars.
!
! <BRANDT.DEVELOPMENT>NCPCEX.B36.1 28-Sep-82 14:01:12, Edit by BRANDT
!
! Ident 45.
! In NICE_INITIALIZE also set RB_NICE_FUNCTION in the request
! block.
!
! <BRANDT.DEVELOPMENT>NCPCEX.B36.1 16-Sep-82 17:34:21, Edit by BRANDT
!
! Ident 44.
! In NM_PARMS special case a PARM_TYPE of P$ALL (377777) since it
! has bit 16 set and now looks like a qualifier keyword.
!
! <BRANDT.DEVELOPMENT>NCPCEX.B36.1 27-Aug-82 11:54:12, Edit by BRANDT
!
! Ident 43.
! In NICE_TEST update RB_NICE_POINTER when access control info is
! supplied.
!
! NET:<PECKHAM.DEVELOPMENT>NCPCEX.B36.2 26-Jun-82 15:55:11, Edit by PECKHAM
!
! Ident 42.
! QUOTE_FIELD was moving one-too-many characters. This caused it to quote
! all trailing nulls (caused by a second bug), thus overwriting memory.
! Both bugs fixed.
! NOTE: this indicates a data-base bug in the XCTR data base. It does not
! have enough room allocated for poossible quoted characters.
! Double length of buffers in NCP$LOOP and XCTR_BLOCK (NCPCOM).
!
! NET:<PECKHAM.DEVELOPMENT>NCPCEX.B36.4 23-Jun-82 12:24:51, Edit by PECKHAM
!
! Ident 41.
! Set privledged bits in request block (user has at least operator privledges).
!
! NET:<PLATUKIS>NCPCEX.B36.2 14-Jun-82 14:59:10, Edit by PLATUKIS
!
! ident 40
! change algorithm of known qualifier keywords.
!
! NET:<PECKHAM.DEVELOPMENT>NCPCEX.B36.2 28-May-82 21:06:15, Edit by PECKHAM
!
! Ident 39.
! Fix CVATH to insert HEX strings with low order byte first.
! This showed up first a screwy SERVICE PASSWORDS.
! Also make fixes to ASSEMBLER cases HI and HX8.
!
! NET:<BRANDT.DEVELOP>NCPCEX.B36.1 28-Apr-82 11:15:47, Edit by BRANDT
!
! Ident 38.
! Change error message on DEFINE / PURGE EXECUTOR commands.
!
! NET:<VOBA.NML.DEVELOPMENT>NCPCEX.B36.7 9-Apr-82 14:39:42, Edit by VOBA
!
! Ident 37.
! Fix CVATH to use -1 as the invalid character in the HEX conversion table
! instead of 0.
!
! NET:<VOBA.NML.DEVELOPMENT>NCPCEX.B36.8 26-Mar-82 18:26:46, Edit by VOBA
!
! Ident 36.
! Fix to code to use PUTW to write parameter number in NICE message
! construction.
!
! NET:<VOBA.NML.DEVELOPMENT>NCPCEX.B36.5 25-Mar-82 20:34:26, Edit by VOBA
!
! Ident 35.
! Debug in NICE_PARM routine.
!
! NET:<VOBA.NML.DEVELOPMENT>NCPCEX.B36.2 25-Mar-82 19:02:28, Edit by VOBA
!
! Ident 34.
! Fix code to raise case of CIRCUIT entity id string.
!
! NET:<VOBA.NML.DEVELOPMENT>NCPCEX.B36.25 25-Mar-82 17:05:26, Edit by VOBA
!
! Ident 33.
! Remove default qualifiers for MODULE entity from routine DEFAULT_QUALIFIER.
! Fix NICE_PARM to build NICE parameter data for MODULE clear request to
! accomodate qualifier data.
! Fix NM_PARMS to parse parameters of CLEAR commands as value keywords.
! These should be defined in the NCP parsing table NCPTAB as value keywords.
! Qualified parameters of CLEAR commands are parsed as regular parameters.
!
! NET:<VOBA.NML.DEVELOPMENT>NCPCEX.B36.4 16-Mar-82 13:16:57, Edit by VOBA
!
! Ident 32.
! Fix NM_PARMS to calculate X25-PROTOCOL KNOWN qualifier parameter
! numbers correctly.
!
! NET:<VOBA.NML.DEVELOPMENT>NCPCEX.B36.3 15-Mar-82 17:35:34, Edit by VOBA
!
! Ident 31.
! Fix DEFAULT_QUALIFIER to format SINK EXECUTOR NODE correctly.
!
! NET:<VOBA.NML.DEVELOPMENT>NCPCEX.B36.18 15-Mar-82 16:01:01, Edit by VOBA
!
! Ident 30.
! Add code to recognize all qualifiers of the SHOW commands.
! Fix ASSEMBLER to assemble only non-zero mask bytes of the EVENTS parameter.
!
! NET:<VOBA.NML.DEVELOPMENT>NCPCEX.B36.4 15-Mar-82 10:21:47, Edit by VOBA
!
! Ident 29.
! Fix READ_OPTION to recognize EVENTS option of the SHOW LOGGING command.
!
! <VOBA.NML.DEVELOPMENT>NCPCEX.B36.13 12-Mar-82 13:35:33, Edit by VOBA
!
! Ident 28.
! Fix NCP_READ to process qualifier parameters of SHOW MODULE commands.
! Fix READ_OPTION not to bother with the TO parameter.
! Remove TOPS-10 file handling code (not needed any more).
!
! NET:<GROSSMAN.NML-SOURCES>NCPCEX.B36.3 8-Mar-82 11:26:07, Edit by GROSSMAN
!
! Ident 27.
! Add some calls to NMU$MEMORY_RELEASE at the end of the SHOW_QUEUE routine.
! These calls will deallocate the REQuest blocks and associated data bases that
! would normally be deallocated by the completion routine for a command. Since
! there is no completion routine for SHOW QUEUE, these weren't getting
! released.
!
! NET:<VOBA.NML.DEVELOPMENT>NCPCEX.B36.4 1-Mar-82 14:44:02, Edit by VOBA
!
! Ident 26.
! Assign HI a distinct value different from AI.
! Fix CVATH to recognize hexadecimal digits in lower case also.
!
! NET:<PECKHAM.DEVELOPMENT>NCPCEX.B36.5 26-Feb-82 13:38:34, Edit by PECKHAM
! NET:<VOBA.NML.DEVELOPMENT>NCPCEX.B36.11 26-Feb-82 10:50:48, Edit by VOBA
!
! Ident 25.
! Fix NICE_PARM to reference local data structure, instead of the one defined
! in NMLPRM.
! Surround response texts by $NML$TEXT and convert to lower case;
! $NML$TEXT in NMARCH can be made to raise case if necessary.
!
! NET:<PECKHAM.DEVELOPMENT>NCPCEX.B36.2 24-Feb-82 08:40:54, Edit by PECKHAM
!
! Ident 24.
! Undo last fix, as bug was in inconsistency in NCPTAB.
!
! NET:<PECKHAM.DEVELOPMENT>NCPCEX.B36.2 24-Feb-82 08:02:07, Edit by PECKHAM
!
! Ident 23.
! Fix NM_ENTITY to set the proper FORMAT for logging sinks.
!
! <VOBA.NML.DEVELOPMENT>NCPCEX.B36.16 22-Feb-82 10:28:46, Edit by VOBA
!
! Ident 22.
! Remove NICE parameter definition tables and use the ones already defined
! in NMLPRM. Replaced NP_xxx routines by a single NICE message assembly
! routine, ASSEMBLER.
!
! Fix the checking of the request message type in NCP$QUEUE_REQUEST from
! GETB to ch$rchar in order not to clobber data buffer.
!
! NET:<VOBA.NML>NCPCEX.B36.176 25-Jan-82 16:13:41, Edit by VOBA
!
! Ident 21.
! Remove code from NM_PARMS to create new routines NM_REMOTE (to parse
! remote file name) and NM_NUMBER, NM_EVENT (to parse numeric range and
! event list) for better management and debugging.
!
! Rewrite NP_EVENT to build NICE message for LOGGING parameter correctly.
!
! Adjust pointer in NCP$TELL not to overwrite node number in TELL command.
!
! Remove reference to NCP$ABORT routine. The routine is kept for future
! possible reuse.
!
! NET:<BRANDT.DEVELOP>NCPCEX.B36.1 21-Jan-82 12:45:47, Edit by BRANDT
!
! Ident 20.
! Terminate text for SHOW QUEUE command with a carriage return.
!
! NET:<PECKHAM.DEVELOPMENT>NCPCEX.B36.3 21-Jan-82 09:51:18, Edit by PECKHAM
!
! Ident 19.
! Add DMP parameters and clean up for NM V3.0.0
!
! NET:<BRANDT.DEVELOPMENT>NCPCEX.B36.7 12-Jan-82 16:55:47, Edit by BRANDT
!
! Ident 18.
! Terminate text for SHOW QUEUE command with a null byte.
!
! NET:<BRANDT.DEVELOPMENT>NCPCEX.B36.7 11-Jan-82 11:55:47, Edit by GUNN
!
! Ident 17.
! Update copyright date to 1982.
! Fix calls to NCP$SEND_RESPONSE to pass proper 'MORE' flag.
! Fix code to use NMU debug facility rather than location 135.
!
! NET:<VOBA.NML>NCPCEX.B36.133 11-Jan-82 10:00:05, Edit by VOBA
!
! Ident 16.
! Update NM_PARMS to recognize full NCP command syntax.
! Add parsing routines and parsing look up tables for all NCP commands.
!
! NET:<BRANDT.DEVELOP>NCPCEX.B36.1 17-Dec-81 16:28:57, Edit by BRANDT
!
! Ident 15.
! Fix routine NM_PARMS so that no parameters are included in the
! NICE message for commands like "CLEAR CIRCUIT foo ALL".
!
! NET:<DECNET20-V3P1.NCP.SOURCES>NCPCEX.B36.3 2-Jun-81 16:37:23, Edit by GUNN
!
! Ident 14.
! Fix text of SHOW QUEUE output to print node address as decimal.
! Output ACCEPTED message if command is LOAD, DUMP or LOOP.
!
! NET:<DECNET20-V3P1.NCP.SOURCES>NCPCEX.B36.2 27-May-81 17:17:52, Edit by GUNN
!
! Ident 13.
! Change NICE_TEST to allow CIRCUIT entity and be more defensive about
! other entity types.
!
! NET:<DECNET20-V3P1.BASELEVEL-2.SOURCES>NCPCEX.B36.44 21-May-81 09:51:58, Edit by JENNESS
!
! Change debugging code in NCP$QUEUE_REQUEST to use a page buffer instead
! of the text buffer. It was overrunning the end when interpreting the
! NICE message.
!
! ***** Note that the same problem still exists in the SHOW QUEUE processing.
!
! NET:<DECNET20-V3P1.NCP.SOURCES>NCPCEX.B36.2 13-Apr-81 17:29:20, Edit by GUNN
!
! Always pass entity type of NODE when calling NM_PARMS from NCP_BOOT.
! All parameters are associated with NODE although NCP command entity
! may be circuit.
!
! NET:<DECNET20-V3P1.NCP.SOURCES>NCPCEX.B36.11 9-Apr-81 14:17:21, Edit by GUNN
!
! Add code to handle SERVICE PASSWORD in NICE_PARM routine. Add routine
! CVATH to convert an ASCII string containing only the characters
! 0-9 & A-F to an 8 bit hexadecimal string.
!
! NET:<DECNET20-V3P1.NCP.SOURCES>NCPCEX.B36.2 7-Apr-81 10:46:11, Edit by GUNN
!
! Fix NCP_BOOT to write option byte in the NICE request message.
!
! NET:<DECNET20-V3P1.NCP.SOURCES>NCPCEX.B36.4 3-Apr-81 17:21:00, Edit by GUNN
!
! Fix NCP$TELL to build executor node id in internal format.
!
! NET:<DECNET20-V3P1.NCP.SOURCES>NCPCEX.B36.3 9-Mar-81 09:59:40, Edit by GUNN
!
! Fix NICE_TEST to prefix access control strings with I-field length byte
! in NICE message. Use individual CH$MOVE rather than CH$COPY for each
! field.
!
! NET:<DECNET20-V3P1.NCP.SOURCES>NCPCEX.B36.2 6-Mar-81 21:23:36, Edit by GUNN
!
! Fix NCP$LOOP to handle all combinations of access control and parameters.
!
! NET:<DECNET20-V3P1.BASELEVEL-2.SOURCES>NCPCEX.B36.39 13-Feb-81 16:09:28, Edit by GUNN
! NET:<DECNET20-V3P1.BASELEVEL-2.SOURCES>NCPCEX.B36.38 9-Feb-81 16:40:10, Edit by GUNN
!
! Fix test for presence of access control arguments in NICE_TEST routine to
! be based on lengths rather than pointers. In call from NCP$LOOP add dot
! operator to pass length values rather than address of values.
!
! NET:<DECNET20-V3P1.BASELEVEL-2.SOURCES>NCPCEX.B36.37 9-Feb-81 15:00:05, Edit by GUNN
!
! Make ACCESS_CONTROL routine return parsed item type when it is other
! than keyword.
! Backup parse of keywords in NPC$LOOP after access control only if it is
! a keyword.
!
! NET:<DECNET20-V3P1.BASELEVEL-2.SOURCES>NCPCEX.B36.34 5-Feb-81 17:00:22, Edit by GUNN
!
! Miscellaneous source code cleanup.
!***** NOTE: Still to be done is to go through and make sure all references
! to the NICE option byte use the structures defined in NMARCH.REQ
!
! NET:<DECNET20-V3P1.BASELEVEL-2.SOURCES>NCPCEX.B36.33 4-Feb-81 19:37:04, Edit by GUNN
!
! Move call to NML$REQUEST_ENTER back to before formatting of accepted
! message in routine NCP$QUEUE_REQUEST to fix print out of garbage
! request number.
!
! Update copyright date to 1981.
!
%title 'NCPCEX -- NCP Command EXecutor'
module NCPCEX (
ident ='X03.57'
) =
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:
!
! Executes commands, parsed by OPR and transmitted to NCP via ORION, in
! GALAXY IPCF messages. The blocks are formatted as GALAXY MS blocks as
! described in the Final Functional Specification for the New Operator
! Interface, MLB-78-004-S, 6-Jul-79. The received MS command blocks are
! transformed to NICE messages and passed to NML for execution.
!
! ENVIRONMENT: TOPS-10/20 User mode under NML
!
! AUTHOR: Dale C. Gunn , CREATION DATE: 28-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$COMMAND_INITIALIZE, ! Initialize data base for NCPCEX
NCP$COMMAND, ! Process NCP IPCF command message
NCP$DISPATCH_COMMAND, ! Route to command specific routine
NCP$ABORT, ! Process ABORT command
NCP$CANCEL, ! Process CANCEL command
NCP$CLEAR, ! Process CLEAR command
NCP$DEFINE, ! Process DEFINE command
NCP$DUMP, ! Process DUMP command
NCP$LIST, ! Process LIST command
NCP$LOAD, ! Process LOAD command
NCP$LOOP, ! Process LOOP command
NCP$PURGE, ! Process PURGE command
NCP$SET, ! Process SET command
NCP$SHOW, ! Process SHOW command
NCP$TELL, ! Process TELL prefix
NCP$TRIGGER, ! Process TRIGGER command
NCP$ZERO, ! Process ZERO command
NCP$REQUEST_INITIALIZE : novalue, ! Initialize NML request
NCP$QUEUE_REQUEST : novalue, ! Queue NICE request message to NML
NM_ENTITY, ! Process entity in IPCF format
NM_PARMS, ! Process parameters in IPCF format
NCP_READ, ! Common SHOW/LIST processing
DEFAULT_QUALIFIER : novalue, ! Process SHOW qualifiers
SHOW_QUEUE : novalue, ! Perform SHOW QUEUE command
NCP_CHANGE, ! Common SET/CLEAR/DEFINE/PURGE process
NCP_BOOT, ! Common LOAD/DUMP/TRIGGER processing
CVSTA : novalue, ! Convert SIXBIT node name to ASCII
CVLTU : novalue, ! Convert string to upper case
CVATH, ! Convert ASCII string to 8 bit HEX
CVATHI, ! Convert ASCII string to HEX image
REMOVE_DASHES, ! Remove dashes from an ETHERNET addr
SET_XCTR, ! Perform SET EXECUTOR command
CLEAR_XCTR, ! Perform CLEAR EXECUTOR command
ACCESS_CONTROL, ! Process access control fields
QUOTE_FIELD, ! Quote string with ^V character
SCAN_XCTR_Q, ! Search EXECUTOR data base
READ_OPTION, ! Build READ option byte
NICE_INITIALIZE : novalue, ! Initialize NICE message
NICE_OPTION : novalue, ! Store option byte in NICE message
NICE_TEST : novalue, ! Store NICE test message fields
NICE_ENTITY : novalue, ! Store entity id in NICE message
NICE_PARM, ! Store a parameter in NICE message
ASSEMBLER : novalue, ! Assemble parameters in NICE message
PUTBUF: novalue; ! Format a NICE message for display
!
! MACROS:
!
macro
CH$EXPLODE [] =
CH$CHTAB (%quote %explode (%remaining)) %;
macro
CH$CHTAB [CH] =
%quote %c CH %;
!
! EQUATED SYMBOLS:
!
literal
NICE_BUFFER_LENGTH = 1000, ! NICE buffer size in bytes
NICE_BUFFER_SIZE = ch$allocation (NICE_BUFFER_LENGTH,8), ! In fullwords
NICE_BUFFER_ALLOCATION = NICE_BUFFER_SIZE * %upval; ! In units
!
! OWN STORAGE:
!
own
REQ: ref REQUEST_BLOCK; ! Address of NML request block
own
CMD_PTR, ! Pointer to command text string
ACK_COD, ! Operator ACK code (PID of OPR)
XCTR_NOD_Q: Q_HEADER; ! Head of EXECUTOR node queue
own
TELL_BLOCK_ADDR, ! Address of dynamic TELL block
TELL_BLOCK: ref block [XCTR_SZ] field (XCTR_FIELDS); ! Address of TELL block
bind ! SIXBIT to ASCII translation table
SIXTAB = ch$transtable (CH$EXPLODE (' !"#$%&'), %c'''',
CH$EXPLODE ('()*+,-./0123456789:'),
CH$EXPLODE (';<=>?@ABCDEFGHIJKLM'),
CH$EXPLODE ('NOPQRSTUVWXYZ[\]^_'));
bind ! ASCII to HEX translation table
HEXTAB = ch$transtable (rep 48 of (-1), ! Invalid HEX digits
0,1,2,3,4,5,6,7,8,9,
rep 7 of (-1),
10,11,12,13,14,15, ! HEX digits (upper case)
rep 26 of (-1),
10,11,12,13,14,15, ! HEX digits (lower case)
rep 25 of (-1));
own
TEXT_PTR; ! @@@@@ Temporary for debug @@@@@
!
! EXTERNAL REFERENCES:
!
external routine
NCP$GET_COMMAND, ! Read Next Command Message
NCP$SEND_TO_OPERATOR, ! Send Unsolicited Message to Operator
NCP$SEND_RESPONSE, ! Send Command Response to Operator
NCP$DEQUEUE_RESPONSE, ! NICE Response Processing Routine
NML$DATA_TYPE, ! Return data type/format
NML$UPPER_CASE, ! Check if text must be upper case
NML$INFORMATION, ! Check information type applicability
NMU$NETWORK_LOCAL; ! Get local node name
external routine ! GALAXY routines
P$SETUP: GALXYS, ! OPRPAR semantic setup
P$NFLD: GALXYO, ! OPRPAR semantic routines
P$NARG: GALXYO,
P$PREV: GALXYO,
P$CFM: GALXYO,
P$KEYW: GALXYO,
P$SWIT: GALXYO,
P$USER: GALXYO,
P$NUM: GALXYO,
P$FILE: GALXYO,
P$IFIL: GALXYO,
P$OFIL: GALXYO,
P$FLD: GALXYO,
P$TOK: GALXYO,
P$NODE: GALXYO,
P$SIXF: GALXYO,
P$RNGE: GALXYO,
P$TEXT: GALXYO,
P$DIR: GALXYO,
P$FLOT: GALXYO,
P$TIME: GALXYO,
P$DEV: GALXYO,
P$QSTR: GALXYO,
P$COMMA:GALXYO,
P$UQSTR:GALXYO,
P$ACCT: GALXYO;
external %debug_data_base;
%global_routine ('NCP$COMMAND_INITIALIZE') =
!++
! FUNCTIONAL DESCRIPTION:
!
! Initializes data base for NCPCEX module.
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! True, always.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
NMU$QUEUE_RESET (XCTR_NOD_Q); ! Initialize the EXECUTOR node queue
return 1 ! Always succeeds
end; ! End of NCP$COMMAND_INITIALIZE
%global_routine ('NCP$COMMAND', MS) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Provides the top level NCP command proccessing. Processes a
! GALAXY command message (type .OMCMD), in standard MS block
! format as defined in GLXMAC.MAC, which represents an NCP
! command parsed by OPR. Calls NCP$DISPATCH_COMMAND, with the
! command keyword code, to dispatch to the appropriate NCP
! command specific processing routine.
!
! FORMAL PARAMETERS
!
! MS - Address of the received MS block.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! True if first argument of command message is a keyword,
! false otherwise.
!
! SIDE EFFECTS:
!
! (1) The current position within the PB portion of the MS block
! is initialized to the first PB argument.
!
! (2) A NICE protocol message is created which represents the NCP
! command.
!
!--
begin
local
TEMP; ! local work variable
bind
COM = MS; ! Make MS and COM overlay
map
MS: ref MS_BLOCK (PAGE_SIZE), ! Structure for MS block
COM: ref COM_BLOCK (PAGE_SIZE); ! Structure for COM block
NCP$REQUEST_INITIALIZE (.MS[CODMS$],.CMD_PTR); ! Initialize the request
ACK_COD = .MS[CODMS$]; ! Get and save ACK code of operator
CMD_PTR = ch$ptr(.MS + .COM[CM$COM] + 1); ! Save pointer to command text
if not P_SETUP (.MS + .COM[PB$COM]) ! Initial address of PB (Parse Block)
then $INTERNAL_ERROR$ ('OPRPAR Failure'); ! But this should never fail
if P_NARG (TEMP)
then if .TEMP eql $CMKEY
then begin
P_KEYW (TEMP);
NCP$DISPATCH_COMMAND (.TEMP)
end
else $INTERNAL_ERROR$ ('Invalidly formatted command message block')
else $INTERNAL_ERROR$ ('No fields in message block')
end; ! End of NCP$COMMAND
%routine ('NCP$DISPATCH_COMMAND', KEY_CODE) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Dispatches to the appropriate NCP command processing routine
! based on the command keyword code.
!
! FORMAL PARAMETERS
!
! Value of command keyword code.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! Value of command specific routine,
! if the command keyword code is valid;
! false otherwise.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
case .KEY_CODE from $KNCAN to $KNZRO of
set
[$KNCAN]:
NCP$CANCEL ();
[$KNCLR]:
NCP$CLEAR ();
[$KNDEF]:
NCP$DEFINE ();
[$KNDMP]:
NCP$DUMP ();
[$KNLST]:
NCP$LIST ();
[$KNLOD]:
NCP$LOAD ();
[$KNLOP]:
NCP$LOOP ();
[$KNPUR]:
NCP$PURGE ();
[$KNSET]:
NCP$SET ();
[$KNSHW]:
NCP$SHOW ();
[$KNTEL]:
NCP$TELL ();
[$KNTRG]:
NCP$TRIGGER ();
[$KNZRO]:
NCP$ZERO ();
[inrange,
outrange]:
$INTERNAL_ERROR$ ('Invalid command keyword code')
tes
end; ! End of NCP$DISPATCH_COMMAND
%routine ('NCP$ABORT') =
!++
! FUNCTIONAL DESCRIPTION:
!
! Performs semantic analysis and processing for ABORT command.
! Scans NML Request Queue for entry with a request number which
! matches the one given in the command. If found it is removed
! from the queue. NCP$SEND_RESPONSE is called to provide an
! appropriate indication of action taken.
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! Current position within the PB portion of the MS block.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
literal
TEXT_BUFFER_LENGTH = 80, ! Length of text buffer in characters
TEXT_BUFFER_SIZE = ! Size in fullwords
ch$allocation (TEXT_BUFFER_LENGTH),
TEXT_BUFFER_ALLOCATION = ! Size of allocation in units
TEXT_BUFFER_SIZE * %upval,
TXT_BFR_SZ = 80; ! A screenful
local
TXT_BFR, ! Text buffer address for response text
TEMP; ! Local work variable
if (P_KEYW(TEMP) and .TEMP eql $KNQUE)
then if (P_KEYW(TEMP) and .TEMP eql $KNREQ)
then if (P_NUM(TEMP))
then begin
TXT_BFR = NMU$MEMORY_GET (TXT_BFR_SZ); ! Get text buffer
TEXT_PTR = ch$ptr(.TXT_BFR);
if NML$REQUEST_ABORT (.TEMP) ! Try to abort this request #
then $NMU$TEXT (TEXT_PTR,
TXT_BFR_SZ,
$NML$TEXT ('Request # %D Aborted'),
.TEMP)
else $NMU$TEXT (TEXT_PTR,
TXT_BFR_SZ,
$NML$TEXT ('Request # %D Does not exist'),
.TEMP);
TEMP = NCP$SEND_RESPONSE (0,ch$ptr(.TXT_BFR),.ACK_COD, 0);
NMU$MEMORY_RELEASE (.TXT_BFR,TXT_BFR_SZ); ! Release buffer
return .TEMP
end
else $INTERNAL_ERROR$ ('Request number not present')
else $INTERNAL_ERROR$ ('REQUEST keyword not present')
else $INTERNAL_ERROR$ ('QUEUE keyword not present')
end; ! End of NCP$ABORT
%routine ('NCP$CANCEL') =
!++
! FUNCTIONAL DESCRIPTION:
!
! Performs semantic analysis and processing for CANCEL command.
! Scans NML Request Queue for entry with a request number which
! matches the one given in the command. If found it is removed
! from the queue. NCP$SEND_RESPONSE is called to provide an
! appropriate indication of action taken.
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! Current position within the PB portion of the MS block.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
literal
TEXT_BUFFER_LENGTH = 80, ! Length of text buffer in characters
TEXT_BUFFER_SIZE = ! Size in fullwords
ch$allocation (TEXT_BUFFER_LENGTH),
TEXT_BUFFER_ALLOCATION = ! Size of allocation in units
TEXT_BUFFER_SIZE * %upval,
TXT_BFR_SZ = 80; ! A screenful
local
TXT_BFR, ! Text buffer address for response text
TEMP; ! Local work variable
if (P_KEYW(TEMP) and .TEMP eql $KNQUE)
then if (P_KEYW(TEMP) and .TEMP eql $KNREQ)
then if (P_NUM(TEMP))
then begin
TXT_BFR = NMU$MEMORY_GET (TXT_BFR_SZ); ! Get text buffer
TEXT_PTR = ch$ptr(.TXT_BFR);
selectone NML$REQUEST_CANCEL (.TEMP) of
set
[0]: $NMU$TEXT (TEXT_PTR,
TXT_BFR_SZ,
$NML$TEXT ('Request # %D cancelled'),
.TEMP) ;
[1]: $NMU$TEXT (TEXT_PTR,
TXT_BFR_SZ,
$NML$TEXT ('Request # %D does not exist'),
.TEMP);
[2]: $NMU$TEXT (TEXT_PTR,
TXT_BFR_SZ,
$NML$TEXT ('Request # %D is active. It cannot be cancelled'),
.TEMP);
tes;
TEMP = NCP$SEND_RESPONSE (0,ch$ptr(.TXT_BFR),.ACK_COD, 0);
NMU$MEMORY_RELEASE (.TXT_BFR,TXT_BFR_SZ); ! Release buffer
return .TEMP
end
else $INTERNAL_ERROR$ ('Request number not present')
else $INTERNAL_ERROR$ ('REQUEST keyword not present')
else $INTERNAL_ERROR$ ('QUEUE keyword not present')
end; ! End of NCP$CANCEL
%routine ('NCP$CLEAR') =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
literal
VOLATILE_ = 0, ! Change volatile parameters
CLEAR_PURGE = 1; ! Perform CLEAR_PURGE
NICE_INITIALIZE (CLEAR_); ! Initialize NICE message
if NCP_CHANGE (VOLATILE_,CLEAR_PURGE)
then $TRUE
else $INTERNAL_ERROR$ ('Invalid syntax in CLEAR command')
end; ! End of NCP$CLEAR
%routine ('NCP$DEFINE') =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
literal
PERMANENT_ = 1, ! Change permanent parameters
SET_DEFINE = 0; ! Perform SET/DEFINE
NICE_INITIALIZE (DEFINE_); ! Initialize NICE message
if NCP_CHANGE (PERMANENT_,SET_DEFINE)
then $TRUE
else $INTERNAL_ERROR$ ('Invalid syntax in DEFINE command')
end; ! End of NCP$DEFINE
%routine ('NCP$DUMP') =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
NICE_INITIALIZE (DUMP_); ! Initialize NICE message
NCP_BOOT () ! Do the common boot processing
end; ! End of NCP$DUMP
%routine ('NCP$LIST') =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
literal
PERMANENT = 1; ! Read permanent parameters
NICE_INITIALIZE (LIST_); ! Initialize NICE message
if NCP_READ (PERMANENT)
then $TRUE
else $INTERNAL_ERROR$ ('Invalid syntax in LIST command')
end; ! End of NCP$LIST
%routine ('NCP$LOAD') =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
NICE_INITIALIZE (LOAD_); ! Initialize NICE message
NCP_BOOT () ! Do the common boot processing
end; ! End of NCP$LOAD
%routine ('NCP$LOOP') =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! Current position within the PB portion of the MS block.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
local
TEMP,
OPTION_BYTE,
ENTITY_TYPE : FULL_ENTITY,
FORMAT,
LENGTH,
ENTITY_POINTER,
USR_LEN,
ACT_LEN,
PWD_LEN,
USR_STRING: ch$sequence (2*16),
PWD_STRING: ch$sequence (2*16),
ACT_STRING: ch$sequence (2*16);
NICE_INITIALIZE (LOOP_); ! Initialize NICE message
if (TEMP = NM_ENTITY (ENTITY_TYPE, ! Get entity field from command
FORMAT,
LENGTH,
ENTITY_POINTER))
then (case .ENTITY_TYPE[ENTITY_MAIN] from ENTITY_LO to ENTITY_HI of
set
[ENTITY_NODE]: ! NODE
begin ! Special case for NODE id
local
NODE_STRING: CH$SEQUENCE(6,8); ! Storage for node name
CVSTA (.FORMAT, ! Convert node id to string
.LENGTH,
.ENTITY_POINTER,
ch$ptr(NODE_STRING,,8));
!
! Get access control fields, returning next keyword code
!
TEMP = ACCESS_CONTROL (ch$ptr(USR_STRING),USR_LEN,
ch$ptr(ACT_STRING),ACT_LEN,
ch$ptr(PWD_STRING),PWD_LEN);
if .TEMP neq N$XACT ! If next item was keyword
then P_PREV (); ! Back up to make NM_PARMS work
NICE_TEST (ch$ptr(USR_STRING),.USR_LEN,
ch$ptr(PWD_STRING),.PWD_LEN,
ch$ptr(ACT_STRING),.ACT_LEN,
.ENTITY_TYPE,
.FORMAT,
.LENGTH,
ch$ptr(NODE_STRING,,8));
end;
[ENTITY_LINE, ! LINE & CIRCUIT
ENTITY_CIRCUIT]:
begin
NICE_TEST (.ENTITY_TYPE,
.FORMAT,
.LENGTH,
.ENTITY_POINTER);
end;
[inrange,outrange]:
$INTERNAL_ERROR$ ('Invalid entity keyword for LOOP');
tes)
else return .TEMP;
! Force NM_PARMS to interpret all parameters as NODE
! entity parameters.
NM_PARMS (ENTITY_NODE, 0) ! Process any node parameters supplied
end; ! End of NCP$LOOP
%routine ('NCP$PURGE') =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
literal
PERMANENT_ = 1, ! Change permanent parameters
CLEAR_PURGE = 1; ! Perform CLEAR_PURGE
NICE_INITIALIZE (PURGE_); ! Initialize NICE message
if NCP_CHANGE (PERMANENT_,CLEAR_PURGE)
then $TRUE
else $INTERNAL_ERROR$ ('Invalid syntax in PURGE command')
end; ! End of NCP$PURGE
%routine ('NCP$SET') =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
literal
VOLATILE_ = 0, ! Change volatile parameters
SET_DEFINE = 0; ! Perform SET/DEFINE
NICE_INITIALIZE (SET_); ! Initialize NICE message
if NCP_CHANGE (VOLATILE_,SET_DEFINE)
then $TRUE
else $INTERNAL_ERROR$ ('Invalid syntax in SET command')
end; ! End of NCP$SET
%routine ('NCP$SHOW') =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
literal
VOLATILE_ = 0; ! Read volatile parameters
NICE_INITIALIZE (SHOW_); ! Initialize NICE message
if NCP_READ (VOLATILE_)
then $TRUE
else $INTERNAL_ERROR$ ('Invalid syntax in SHOW command')
end; ! End of NCP$SHOW
%routine ('NCP$TELL') =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! Current position within the PB portion of the MS block.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
local
REQ_DATA: ref XCTR_BLOCK, ! Address of Request data
FORMAT,
LENGTH,
NOD_PTR,
USR_LEN,
ACT_LEN,
PWD_LEN,
TEMP; ! Local work variable
REQ_DATA = .REQ[RB_DATA]; ! Get address of source data block
NOD_PTR = ch$ptr(REQ_DATA[NOD_ID],,8); ! Initialize pointer to node id
if P_NODE (TEMP) ! Node name
then begin
FORMAT = 0; ! Store node address of zero
PUTW (FORMAT, NOD_PTR);
FORMAT = ! Length & format are
LENGTH = CH$MIN(ch$ptr(TEMP,,6), 6); ! less than six
PUTB (.FORMAT, NOD_PTR); ! Write node entity format
CVSTA (.FORMAT, ! Convert node id to string
.LENGTH,
.TEMP,
.NOD_PTR);
end
else if P_NUM (TEMP)
then begin ! Node address
local TMP,LEN;
FORMAT = 0; ! Node address format
LENGTH = 2; ! 2 byte node address
P_NARG (TMP,LEN); ! Peek at next
if .TMP eql $CMTOK
then begin ! Possibly x.y node address format
P_TOK (TMP);
TMP = ch$ptr(.TMP+1); ! Get pointer to token
LEN = ch$len(.TMP); ! Get length
if ch$eql(.LEN,.TMP,1,ch$asciz('.'))
then begin ! It is a .
P_TOK (TMP); ! Eat up the .
if not P_NUM (TMP) then ! Get the rest of the node address
$INTERNAL_ERROR$ ('Invalidly formatted message block');
if (.temp lss 0 or .temp gtr 63) or (.tmp lss 0 or .tmp gtr 1023) then ! Node value in range?
$INTERNAL_ERROR$ ('Invalid node or area number specified');
TEMP = .TEMP * 1024 + .TMP; ! Compute the whole node address
end
else begin
if (.temp lss 0 or .temp gtr 1023) then
$INTERNAL_ERROR$ ('Invalid node number specified');
P_PREV (TMP); ! Not a ., backup parsing pointer
end
end;
if .TEMP eql 0 ! Valid node address?
then $INTERNAL_ERROR$ ('Zero is an invalid node number');
CVSTA (.FORMAT, ! Convert node id to string
.LENGTH,
.TEMP,
.NOD_PTR);
NOD_PTR = ch$plus(.NOD_PTR,2);
PUTB (.FORMAT,NOD_PTR); ! Null node name string
end
else $INTERNAL_ERROR$ ('node name not present in TELL syntax');
REQ[RB_EXECUTOR] = REQ_DATA[NOD_ID]; ! Store address of EXECUTOR node id
!
! Get access control fields, returning next keyword code
!
TEMP = ACCESS_CONTROL (ch$ptr(REQ_DATA[USR_ID],1),USR_LEN,
ch$ptr(REQ_DATA[ACTSTR],1),ACT_LEN,
ch$ptr(REQ_DATA[PWDSTR],1),PWD_LEN);
ch$wchar(.USR_LEN,ch$ptr(REQ_DATA[USR_ID])); ! Write length byte
ch$wchar(.ACT_LEN,ch$ptr(REQ_DATA[ACTSTR])); ! Write length byte
ch$wchar(.PWD_LEN,ch$ptr(REQ_DATA[PWDSTR])); ! Write length byte
!
! Update Request Block to point to access control fields
!
REQ[RB_USER_LENGTH] = .USR_LEN;
if .USR_LEN gtr 0
then REQ[RB_USER] = ch$ptr (REQ_DATA[USR_ID],1);
REQ[RB_ACCOUNT_LENGTH] = .ACT_LEN;
if .ACT_LEN gtr 0
then REQ[RB_ACCOUNT] = ch$ptr (REQ_DATA[ACTSTR],1);
REQ[RB_PASSWORD_LENGTH] = .PWD_LEN;
if .PWD_LEN gtr 0
then REQ[RB_PASSWORD] = ch$ptr (REQ_DATA[PWDSTR],1);
!
! Dispatch to perform command
!
NCP$DISPATCH_COMMAND (.TEMP)
end; ! End of NCP$TELL
%routine ('NCP$TRIGGER') =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
NICE_INITIALIZE (TRIGGER_); ! Initialize NICE message
NCP_BOOT () ! Do the common boot processing
end; ! End of NCP$TRIGGER
%routine ('NCP$ZERO') =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
literal
ZERO_ONLY = 0,
READ_AND_ZERO = 1;
local
TEMP,
ENTITY_TYPE : FULL_ENTITY,
FORMAT,
LENGTH,
ENTITY_POINTER,
OPTION_BYTE: block [1] field (ZERO_OPTIONS);
NICE_INITIALIZE (ZERO_); ! Initialize NICE message
if (TEMP = NM_ENTITY (ENTITY_TYPE, ! Get entity field from command
FORMAT,
LENGTH,
ENTITY_POINTER))
then begin
OPTION_BYTE[ZO_ENTITY_TYPE] = .ENTITY_TYPE;
OPTION_BYTE[ZO_READ_AND_ZERO] = ZERO_ONLY;
NICE_OPTION (.OPTION_BYTE); ! Write option byte
if .ENTITY_TYPE[ENTITY_MAIN] eql ENTITY_NODE ! Special case for NODE id
then begin
local NODE_STRING: CH$SEQUENCE(6,8); ! Storage for node name
CVSTA (.FORMAT, ! Convert node id to string
.LENGTH,
.ENTITY_POINTER,
ch$ptr(NODE_STRING,,8));
NICE_ENTITY (.FORMAT, ! Write entity id field
.LENGTH,
ch$ptr(NODE_STRING,,8));
end
else NICE_ENTITY (.FORMAT, ! Write entity field
.LENGTH,
.ENTITY_POINTER);
end
else return .TEMP;
if .ENTITY_TYPE[ENTITY_MAIN] eql ENTITY_MODULE
then NM_PARMS (.ENTITY_TYPE, 0) ! Only MODULE has parameters
else begin
NCP$QUEUE_REQUEST (0);
return .TEMP
end
end; ! End of NCP$ZERO
%routine ('NCP$REQUEST_INITIALIZE', OPERATOR_ID, CMD_PTR) : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! Performs initialization processing for a NICE request. Allocates
! storage required for performing the request and initializes
! various fields within the request block.
!
! FORMAL PARAMETERS
!
! OPERATOR_ID - A value which distinguishes the operator from whence this
! request has come.
!
! CMD_PTR - A character sequence pointer to the command text string.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
local
REQ_DATA: ref XCTR_BLOCK, ! Address of Request data
LENGTH, ! Length of command text
TEMP;
REQ = NMU$MEMORY_GET (REQUEST_BLOCK_ALLOCATION); ! Allocate Request Block
REQ[RB_NICE] = NMU$MEMORY_GET (NICE_BUFFER_ALLOCATION);
REQ[RB_NICE_ALLOCATION] = NICE_BUFFER_ALLOCATION ; ! Units allocated
REQ[RB_NICE_LENGTH] = 0; ! Initially no NICE message
REQ[RB_NICE_POINTER] = ch$ptr (.REQ[RB_NICE], ! Point to NICE message
0, ! No offset
8); ! DECnet byte size
REQ[RB_EXECUTOR] = 0; ! Initialize to process locally
REQ[RB_PRV_SYSTEM] = $true; ! Set privledges.
REQ[RB_PRV_SERVICE] = $true;
REQ[RB_PRV_TEST] = $true;
REQ[RB_PRV_CHANGE] = $true;
REQ[RB_PRV_READ] = $true;
!
! Allocate block for additional data used by NCP
!
REQ_DATA = NMU$MEMORY_GET (EXECUTOR_BLOCK_ALLOCATION);
REQ[RB_DATA] = .REQ_DATA; ! Save address of data block
REQ[RB_DATA_ALLOCATION] = EXECUTOR_BLOCK_ALLOCATION; ! Units allocated
REQ_DATA[OPR_ID] = .OPERATOR_ID; ! Set Operator Id
%( N.B. - This code will save the command typein string from the IPCF message
for use during response processing. It is turned off now because the
NML request handler code does not return this info in the RB on the
call to NML$REQUEST_SHOW. Also needs a variable to hold size of
command buffer.
LENGTH = CH$LEN (.CMD_PTR); ! Get length of command string
TEMP = ch$allocation (.LENGTH + 1); ! Size of block in words
REQ_DATA[CMD_ADR] = NMU$MEMORY_GET (.TEMP); ! Use this temporarily
ch$move (.LENGTH,.CMD_PTR,ch$ptr(.REQ_DATA[CMD_ADR])); ! Copy string
)%
REQ[RB_COMPLETION] = NCP$DEQUEUE_RESPONSE; ! Completion routine
end; ! End of NCP$REQUEST_INITIALIZE
%routine ('NCP$QUEUE_REQUEST', TO_FIL) : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! Places a request on the NICE request queue for processing.
!
! FORMAL PARAMETERS
!
! TO_FIL - File handle of file in which output may be directed
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
literal
TEXT_BUFFER_LENGTH = 80, ! Length of text buffer in characters
TEXT_BUFFER_SIZE = ! Size in fullwords
ch$allocation (TEXT_BUFFER_LENGTH),
TEXT_BUFFER_ALLOCATION = ! Size of allocation in units
TEXT_BUFFER_SIZE * %upval,
TXT_BFR_SZ = 80; ! A screenful
local
TXT_BFR; ! Text buffer address for response
local
REQ_DATA: ref XCTR_BLOCK, ! Address of Request data
REQ_NO, ! NML Request number
NICE_ADDR, ! Address of NICE request buffer
NICE_LENGTH, ! Length of NICE request in bytes
TEMP;
REQ_DATA = .REQ[RB_DATA]; ! Get address of source data block
REQ_DATA[TO_FILE] = .TO_FIL; ! Output goes to file named
%( Determine if there is a TELL_BLOCK created for this command.
If so, use executor node from it. If it also contains access
control info use it, otherwise look for an XCTR_BLOCK on the
queue for this OPR ID and this node, if it contains access control
info use that. If access control info is not available in either
TELL_BLOCK or XCTR_BLOCK then use null.
If there is no TELL_BLOCK for this command, search for
the first XCTR_BLOCK for this OPR ID and use all info from it. )%
if .REQ[RB_EXECUTOR] eql 0 ! Check if TELL prefix used
then begin ! If not then look for SET EXECUTOR
local
SPTR,
DPTR,
LENGTH,
XCTR: ref block[XCTR_SZ] field(XCTR_FIELDS);
if (XCTR = NMU$QUEUE_SCAN (XCTR_NOD_Q,
.REQ_DATA[OPR_ID],
SCAN_XCTR_Q)) neq 0
then begin ! An EXECUTOR has been set
SPTR = ch$ptr (XCTR[NOD_ID],,8); ! Point to EXECUTOR node id
DPTR = ch$ptr (REQ_DATA[NOD_ID],,8);
ch$wchar_a (ch$rchar_a(SPTR),DPTR); ! Copy node address
ch$wchar_a (ch$rchar_a(SPTR),DPTR);
ch$wchar_a ((LENGTH = ch$rchar_a(SPTR)) ! Write length byte
,DPTR);
ch$move (.LENGTH,.SPTR,.DPTR); ! Move id string
REQ[RB_EXECUTOR] = REQ_DATA[NOD_ID]; ! Address of executor id
SPTR = ch$ptr (XCTR[USR_ID]); ! Point to user id
DPTR = ch$ptr (REQ_DATA[USR_ID]);
ch$wchar_a ((LENGTH = ch$rchar_a(SPTR)) ! Write length byte
,DPTR);
ch$move (.LENGTH,.SPTR,.DPTR); ! Move id string
REQ[RB_USER_LENGTH] = .LENGTH;
if .LENGTH gtr 0
then REQ[RB_USER] = .DPTR; ! Make request use USER id
SPTR = ch$ptr (XCTR[ACTSTR]); ! Point to account string
DPTR = ch$ptr (REQ_DATA[ACTSTR]);
ch$wchar_a ((LENGTH = ch$rchar_a(SPTR)) ! Write length byte
,DPTR);
ch$move (.LENGTH,.SPTR,.DPTR); ! Move id string
REQ[RB_ACCOUNT_LENGTH] = .LENGTH;
if .LENGTH gtr 0
then REQ[RB_ACCOUNT] = .DPTR; ! Make request use ACCOUNT
SPTR = ch$ptr (XCTR[PWDSTR]); ! Point to password string
DPTR = ch$ptr (REQ_DATA[PWDSTR]);
ch$wchar_a ((LENGTH = ch$rchar_a(SPTR)) ! Write length byte
,DPTR);
ch$move (.LENGTH,.SPTR,.DPTR); ! Move id string
REQ[RB_PASSWORD_LENGTH] = .LENGTH;
if .LENGTH gtr 0
then REQ[RB_PASSWORD] = .DPTR; ! Make request use PASSWORD
end;
end;
NICE_ADDR =.REQ[RB_NICE]; ! Save address of NICE request buffer
NICE_LENGTH = .REQ[RB_NICE_LENGTH]; ! And message length
REQ_NO = NML$REQUEST_ENTER (.REQ); ! Enter request in queue
TXT_BFR = NMU$MEMORY_GET (TXT_BFR_SZ); ! Get text buffer
!
! Return a response message now indicating we've accepted the command
! for any command which may take a significant amount of time to perform.
!
if (.REQ[RB_EXECUTOR] neq 0) ! Was an executor set?
or ((TEMP = ch$rchar (ch$ptr(.NICE_ADDR,,8))) eql LOAD_) ! Or LOAD command
or (.TEMP eql DUMP_) ! Or DUMP command
or (.TEMP eql LOOP_) ! Or LOOP command
then begin ! Yes, then print accepted message
TEXT_PTR = ch$ptr(.TXT_BFR); ! Set up pointer to text
$NMU$TEXT (TEXT_PTR, ! Build an acceptance message
TXT_BFR_SZ,
$NML$TEXT ('Request # %D Accepted'),
.REQ_NO);
NCP$SEND_RESPONSE (0,ch$ptr(.TXT_BFR), ! Send it back to operator
.REQ_DATA[OPR_ID], 0);
end;
%debug (NCP_NICE_VALIDATION, ! Print the content of the NICE
(begin ! message buffer as an ASCII text
builtin LSH;
local PAGE, PTR, TMP;
PAGE = NMU$PAGE_GET ();
PTR = TMP = ch$ptr (LSH (.PAGE,9));
$NMU$TEXT (TMP, TEXT_BUFFER_LENGTH,
'%/[NICE Request Message]%/%N');
PUTBUF (TMP, 0, .NICE_ADDR, .NICE_LENGTH);
NCP$SEND_RESPONSE (0, .PTR, .REQ_DATA[OPR_ID], 0);
NMU$PAGE_RELEASE (.PAGE);
end));
NMU$MEMORY_RELEASE (.TXT_BFR,TXT_BFR_SZ); ! Release buffer
end; ! End of NCP$QUEUE_REQUEST
%routine ('NM_ENTITY', ENTITY_TYPE, FORMAT, LENGTH, ENTITY_POINTER) =
!++
! FUNCTIONAL DESCRIPTION:
!
! The entity portion of an NCP command parsed by OPR is
! converted into the primitive fields required to build
! a NICE message.
!
! FORMAL PARAMETERS
!
! ENTITY_TYPE - The address of a variable which is to receive
! the full entity type representing the entity.
!
! FORMAT - The address of a variable which will contain
! the entity format/length field.
!
! LENGTH - The address of a variable which will contain the
! length of the entity id string. This length
! represents the length of the complete entity id
! field and will not necessarily be the same as
! the length encoded in the format field of
! the NICE message. If zero the contents of
! ENTITY_POINTER should be ignored.
!
! ENTITY_POINTER - The address of a variable which will contain
! a character sequence pointer to the entity id
! string,
! or, in the case of ENTITY_AREA, or ENTITY_NODE
! the address of a variable which will contain
! the entity id value. (a number or 6 SIXBIT chars)
!
! IMPLICIT INPUTS
!
! Current position within the PB portion of the MS block.
!
! ROUTINE VALUE: True or False.
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
map
ENTITY_TYPE : ref FULL_ENTITY;
local
T_ADDR, ! Address temporary variable
T_LTH, ! Length temporary variable
TEMP; ! Local work variable
!
! Find out what entity keyword was parsed
!
if not P_NARG (TEMP)
then $INTERNAL_ERROR$ ('Message block terminated prematurely')
else if .TEMP nequ $CMKEY
then $INTERNAL_ERROR$ ('Invalidly formatted message block')
else P_KEYW (TEMP); ! Get entity keyword value
!
! Interpretation of entity id field is dependent on entity keyword
!
selectone .TEMP of
set
!************
!* EXECUTOR *
!************
[$KNXTR]: ! EXECUTOR
begin
.ENTITY_TYPE = ENTITY_NODE; ! Return node entity value
.FORMAT = 0; ! Indicate node address format
.LENGTH = 2; ! 2 byte node address
.ENTITY_POINTER = 0; ! Zero is EXECUTOR
return $TRUE
end;
!***********
!* CIRCUIT *
!* or *
!* VIA *
!***********
[$KNCKT, ! CIRCUIT
$KNVIA]: ! VIA ... a pseudonym
begin
if not P_FLD (T_ADDR,T_LTH)
then $INTERNAL_ERROR$ ('Invalidly formatted message block');
.ENTITY_TYPE = ENTITY_CIRCUIT; ! Return circuit entity value
.FORMAT = .LENGTH = CH$LEN (ch$ptr(.T_ADDR+1));
.ENTITY_POINTER = ch$ptr(.T_ADDR+1);
CVLTU (..ENTITY_POINTER, ..LENGTH); ! Upper case circuit id
return $TRUE
end;
!****************************************************
!* SELECTORS - KNOWN, ACTIVE, ADJACENT, SIGNIFICANT *
!****************************************************
[$KNKNW, ! KNOWN
$KNATV, ! ACTIVE
$KNADJ, ! ADJACENT
$KNSIG ! SIGNIFICANT
]:
begin
selectone .TEMP of
set
[$KNKNW]:
.FORMAT = KNOWN_; ! Class format
[$KNATV]:
.FORMAT = ACTIVE_; ! Class format
[$KNADJ]:
.FORMAT = ADJACENT_; ! Class format
[$KNSIG]:
.FORMAT = SIGNIFICANT_; ! Class format
tes;
if not P_KEYW (TEMP) ! Get entity keyword value
then $INTERNAL_ERROR$ ('Invalidly formatted message block');
.LENGTH = 0; ! Only format byte
.ENTITY_POINTER = 0; ! Null pointer
selectone .TEMP of
set
[$KNCKT]:
.ENTITY_TYPE = ENTITY_CIRCUIT;
[$KNLGG]:
.ENTITY_TYPE = ENTITY_LOGGING;
[$KNLIN]:
.ENTITY_TYPE = ENTITY_LINE;
[$KNNOD]:
.ENTITY_TYPE = ENTITY_NODE;
[$KNMDL]:
.ENTITY_TYPE = ENTITY_MODULE;
[$KNARE]:
.ENTITY_TYPE = ENTITY_AREA;
[otherwise]:
$INTERNAL_ERROR$ ('Invalid entity type keyword');
tes;
return $TRUE
end;
!***********
!* LOGGING *
!***********
[$KNLGG]: ! LOGGING
begin
if not P_KEYW (TEMP)
then $INTERNAL_ERROR$ ('Invalidly formatted message block');
.LENGTH = 0; ! Only format byte
.ENTITY_POINTER = 0; ! Null pointer
.FORMAT = .TEMP; ! Logging id
.ENTITY_TYPE = ENTITY_LOGGING;
return $TRUE
end;
!********
!* NODE *
!********
[$KNNOD]: ! NODE
begin
if P_NODE (TEMP)
then begin ! Node name
.FORMAT = ! Length & format are
.LENGTH = CH$MIN(ch$ptr(TEMP,,6), 6); ! less than six
%( N.B. - This is a special case use of the ENTITY_POINTER parameter due
to the fact that the node name from OPR is in SIXBIT and is
passed back as a value and not a string. The caller will have to
be prepared to handle this. Problem is we have no way to allocate
memory for the string here and can't leave it in a local variable. )%
.ENTITY_POINTER = .TEMP;
end
else if P_NUM (TEMP)
then begin ! Node address
local TMP,LEN;
.FORMAT = 0; ! Node address format
.LENGTH = 2; ! 2 byte node address
P_NARG (TMP,LEN); ! Peek at next
if .TMP eql $CMTOK
then begin ! Possibly x.y node address format
P_TOK (TMP);
TMP = ch$ptr(.TMP+1); ! Get pointer to token
LEN = ch$len(.TMP); ! Get length
if ch$eql(.LEN,.TMP,1,ch$asciz('.'))
then begin ! It is a .
P_TOK (TMP); ! Eat up the .
if not P_NUM (TMP) then ! Get the rest of the node address
$INTERNAL_ERROR$ ('Invalidly formatted message block');
TEMP = .TEMP * 1024 + .TMP; ! Compute the whole node address
end
else
P_PREV (TMP); ! Not a ., backup parsing pointer
end;
if .TEMP eql 0 ! Valid node address?
then $INTERNAL_ERROR$ ('Zero is an invalid node number');
%( N.B. - Special case as above. )%
.ENTITY_POINTER = .TEMP;
end
else $INTERNAL_ERROR$ ('Invalidly formatted message block');
.ENTITY_TYPE = ENTITY_NODE; ! Return node entity value
return $TRUE
end;
!********
!* AREA * $$UNDER DEVELOPMENT$$
!********
[$KNARE]: ! AREA
begin
%( N.B. - This is another special case use of the ENTITY_POINTER parameter due
to the fact that the area name from OPR is a number and is
passed back as a value and not a string. The caller will have to
be prepared to handle this. Problem is we have no way to allocate
memory for the string here and can't leave it in a local variable. )%
if not P_NUM (TEMP)
then $INTERNAL_ERROR$ ('Invalidly formatted message block');
.ENTITY_TYPE = ENTITY_AREA; ! Return area entity value
.FORMAT = 0; ! Area address format.
.LENGTH = 1; ! Area address is one byte.
.ENTITY_POINTER = .TEMP; ! The entity id value.
return $TRUE
end;
!********
!* LINE *
!********
[$KNLIN]: ! LINE
begin
if not P_FLD (T_ADDR)
then $INTERNAL_ERROR$ ('Invalidly formatted message block');
.ENTITY_TYPE = ENTITY_LINE; ! Return line entity value
.FORMAT = .LENGTH = CH$LEN (ch$ptr(.T_ADDR+1));
.ENTITY_POINTER = ch$ptr(.T_ADDR+1);
CVLTU (..ENTITY_POINTER, ..LENGTH); ! Upper case line id
return $TRUE
end;
!********
!* LOOP *
!********
[$KNLOP]: ! LOOP class
begin
if not P_KEYW (TEMP)
then $INTERNAL_ERROR$ ('Invalidly formatted message block');
.FORMAT = LOOPED_; ! Class format
.LENGTH = 0; ! Only format byte
.ENTITY_POINTER = 0; ! Null pointer
selectone .TEMP of
set
[$KNNOD]:
.ENTITY_TYPE = ENTITY_NODE; ! Return node entity type value
[otherwise]:
$INTERNAL_ERROR$ ('Invalid LOOP class entity keyword')
tes;
return $TRUE
end;
!**********
!* MODULE *
!**********
[$KNMDL]: ! MODULE
begin
if not P_KEYW (TEMP)
then $INTERNAL_ERROR$ ('Invalidly formatted message block');
case .TEMP from $KNCFG to $KNXSV of
set
[$KNXSV]:
begin
.ENTITY_TYPE = ENTITY_MODULE_X25_SERVER;
.ENTITY_POINTER = CH$ASCIZ ('X25-SERVER');
end;
[$KNXAC]:
begin
.ENTITY_TYPE = ENTITY_MODULE_X25_ACCESS;
.ENTITY_POINTER = CH$ASCIZ ('X25-ACCESS');
end;
[$KNXPR]:
begin
.ENTITY_TYPE = ENTITY_MODULE_X25_PROTOCOL;
.ENTITY_POINTER = CH$ASCIZ ('X25-PROTOCOL');
end;
[$KNCFG]:
begin
.ENTITY_TYPE = ENTITY_MODULE_CONFIGURATOR;
.ENTITY_POINTER = CH$ASCIZ ('CONFIGURATOR');
end;
[$KNCSL]:
begin
.ENTITY_TYPE = ENTITY_MODULE_CONSOLE;
.ENTITY_POINTER = CH$ASCIZ ('CONSOLE');
end;
[$KNLDR]:
begin
.ENTITY_TYPE = ENTITY_MODULE_LOADER;
.ENTITY_POINTER = CH$ASCIZ ('LOADER');
end;
[$KNLPR]:
begin
.ENTITY_TYPE = ENTITY_MODULE_LOOPER;
.ENTITY_POINTER = CH$ASCIZ ('LOOPER');
end;
[inrange,
outrange]:
$INTERNAL_ERROR$ ('Invalid module entity keyword');
tes;
.FORMAT = .LENGTH = CH$LEN (..ENTITY_POINTER);
return $TRUE;
end;
!*********
!* QUEUE *
!*********
[$KNQUE]: ! QUEUE
begin
macro Q_NAME = 'QUEUE' %;
.ENTITY_TYPE = 8; ! Dummy up a system specific entity #
.FORMAT = .LENGTH = %charcount(Q_NAME); ! Make it complete
.ENTITY_POINTER = CH$ASCII (Q_NAME);
return $TRUE
end;
!***********
!* INVALID *
!* ENTITY *
!***********
[otherwise]: ! Error case
$INTERNAL_ERROR$ ('Invalid entity type keyword');
tes
end; ! End of NM_ENTITY
%routine ('NM_EVENT', NUMBER, BUFFER) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! Current position within the PB portion of the MS block.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
local
TMP,
NUM1,
NUM2;
bind
E_CLASS = (.NUMBER+0),
E_MASK1 = (.NUMBER+1),
E_MASK2 = (.NUMBER+2),
E_ETYPE = (.NUMBER+3),
E_ELEN = (.NUMBER+4),
E_ENAME = (.NUMBER+5);
P_NARG (TMP);
! If the routine is called to process KNOWN EVENTS, then the following
! section of code will not be executed. Following the KNOWN EVENTS keywords,
! there will be neither a token "*" nor a number, but an entity keyword.
! Otherwise, this section is entered with the assumption that the event
! class was parsed and put in the first element of the data vector. The
! parsing pointer now should point to the first event type in the list.
if .TMP eql $CMTOK ! Next field is a token
then begin
P_TOK (TMP); ! Parse "*"
E_CLASS = .E_CLASS or (2^14); ! Set flag bit to indicate all events
P_NARG (TMP); ! Peek at next field
end
else begin ! Otherwise, it should be a number
while (.TMP eql $CMNUM) or (.TMP eql $CMNUX)
do begin
P_NUM (NUM1); ! Parse number
P_NARG (TMP); ! Peek at next field
NUM2 = .NUM1; ! Assume that this is single event type
if .TMP eql $CMTOK ! If next field is a token
then begin ! This is a range
P_TOK (TMP); ! Parse "-"
P_NUM (NUM2); ! Parse ending range
P_NARG (TMP); ! Peek at next field
end;
if .TMP eql $CMCMA ! If it is a comma
then begin
P_COMMA (TMP); ! Parse it
P_NARG (TMP); ! Peek at next field
end;
if .NUM2 lss .NUM1 ! Make sure range is in order
then $INTERNAL_ERROR$ ('Range should be lo-hi');
if .NUM2 gtr 63
then $INTERNAL_ERROR$ ('Upper bound should not exceed 63');
incr I from .NUM1 to .NUM2
do begin
if .I geq 32 ! Set up binary event mask
then E_MASK1<.I-32,1> = 1
else E_MASK2<.I,1> = 1;
end;
end;
end;
! At this point we have to peek at the next field to determine whether
! an entity keyword follows the event list (or the keywords KNOWN EVENTS, if
! the routine is invoked to process KNOWN EVENTS). If there is an entity
! keyword that we expect, then parse it and also parse the entity id field.
! Otherwise, backup parsing pointer, so that NM_PARMS code can parse the
! remaining of the command normally.
if .TMP eql $CMKEY ! Is the next field a keyword
then begin
P_KEYW (TMP); ! Get keyword
selectone .TMP of ! Check if the keyword is a
set
[E$QNOD]: ! NODE entity
begin
E_ETYPE = .TMP; ! Set value for node entity type
if P_NODE (TMP)
then begin
E_ELEN = CH$MIN (ch$ptr(TMP,,6),6);
E_ENAME = ch$ptr(.BUFFER,,8);
CVSTA (.E_ELEN, ! Convert node name to ASCII string
.E_ELEN,
.TMP,
.E_ENAME);
end
else begin
if P_NUM (TMP)
then begin
E_ELEN = 0;
E_ENAME = .TMP;
end;
end;
end;
[E$QCKT, ! LINE entity
E$QLIN]: ! CIRCUIT entity
begin
E_ETYPE = .TMP; ! Set value for line and circuit entity
P_FLD (TMP);
E_ENAME = ch$ptr(.TMP+1);
E_ELEN = CH$LEN (.E_ENAME);
end;
[E$QMDL]: ! MODULE entity
begin
E_ETYPE = .TMP; ! Set value for module entity type
E_ENAME = ch$ptr(.BUFFER,,8);
P_KEYW (TMP); ! Parse module name
case .TMP from $KNCFG to $KNXSV of
set
[$KNXAC]: ! X25-ACCESS
begin
E_ELEN = %charcount('X25-ACCESS');
ch$move (.E_ELEN, CH$ASCII('X25-ACCESS'), .E_ENAME);
end;
[$KNXPR]: ! X25-PROTOCOL
begin
E_ELEN = %charcount('X25-PROTOCOL');
ch$move (.E_ELEN, CH$ASCII('X25-PROTOCOL'), .E_ENAME);
end;
[$KNXSV]: ! X25-SERVER
begin
E_ELEN = %charcount('X25-SERVER');
ch$move (.E_ELEN, CH$ASCII('X25-SERVER'), .E_ENAME);
end;
[$KNCFG]: ! CONFIGURATOR
begin
E_ELEN = %charcount('CONFIGURATOR');
ch$move (.E_ELEN, CH$ASCII('CONFIGURATOR'), .E_ENAME);
end;
[$KNLDR]:
begin
E_ELEN = %charcount('LOADER');
ch$move (.E_ELEN, CH$ASCII('LOADER'), .E_ENAME);
end;
[$KNLPR]:
begin
E_ELEN = %charcount('LOOPER');
ch$move (.E_ELEN, CH$ASCII('LOOPER'), .E_ENAME);
end;
[$KNCSL]:
begin
E_ELEN = %charcount('CONSOLE');
ch$move (.E_ELEN, CH$ASCII('CONSOLE'), .E_ENAME);
end;
[inrange,
outrange]:
E_ETYPE = -1; ! No entity
tes;
end;
[otherwise]: ! If it is not the entity keyword we
begin ! expect, then
E_ETYPE = -1; ! Set value to indicate no entity
P_PREV (TMP); ! Readjust parsing pointer
end;
tes;
end
else E_ETYPE = -1; ! Set value to indicate no entity
return $TRUE;
end; ! End of NM_EVENT
%routine ('NM_NUMBER', NUMBER, BUFFER) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! Current position within the PB portion of the MS block.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
local
LEN,
TMP;
if P_NARG (TMP) and ((.TMP eql $CMTOK) or (.TMP eql $CMCMA))
then begin
if .TMP eql $CMTOK ! Identify token
then begin
P_TOK (TMP); ! Get token
TMP = ch$ptr(.TMP+1); ! Get pointer to token
LEN = CH$LEN(.TMP); ! Get length
if ch$eql(.LEN,.TMP,1,CH$ASCIZ('-'))
then P_NUM (.NUMBER+1) ! Get numeric range
else begin
if ch$eql(.LEN,.TMP,1,CH$ASCIZ('.'))
then NM_EVENT (.NUMBER, .BUFFER)
else P_PREV (TMP); ! Backup parsing pointer
end;
P_NARG (TMP);
end;
if .TMP eql $CMCMA ! If followed by a comma
then P_COMMA (TMP); ! then parse it
end;
return $TRUE;
end; ! End of NM_NUMBER
%routine ('NM_REMOTE', POINTER, LENGTH, BUFFER) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! Current position within the PB portion of the MS block.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
local
LEN,
TMP,
TMP1,
TMP2,
FILEN,
FIPTR;
label X;
if P_NARG (TMP) and ((.TMP eql $CMQST) or (.TMP eql $CMTOK))
then begin
FILEN = MIN(..LENGTH,6);
FIPTR = ch$ptr(.BUFFER,,8);
TMP1 = ch$move (.FILEN,..POINTER,.FIPTR);
if .TMP eql $CMQST ! Field is followed by an optional
then begin ! quoted accounting field
P_QSTR (TMP); ! Parse the optional data field
TMP2 = ch$ptr(.TMP+1); ! Get pointer
LEN = CH$LEN(.TMP2); ! Get length
ch$wchar_a (%C'"',TMP1); ! Recreate quoted accounting string
TMP1 = ch$move (.LEN,.TMP2,.TMP1);
ch$wchar_a (%C'"',TMP1);
P_NARG (TMP); ! Check next argument
if .TMP neq $CMTOK ! If it is not a token, then error
then $INTERNAL_ERROR$ ('Illegal remote file name');
FILEN = .FILEN + .LEN + 2; ! New node name length
end;
if .TMP eql $CMTOK ! Field is followed by a token
then begin
P_TOK (TMP); ! Parse the token
TMP2 = ch$ptr(.TMP+1); ! Get pointer
LEN = CH$LEN(.TMP2); ! Get length
if not ch$eql(.LEN,.TMP2,2,CH$ASCIZ('::'))
then $INTERNAL_ERROR$ ('Illegal remote file name')
else begin ! If it is "::", then everything is OK
TMP1 = ch$move (2,.TMP2,.TMP1); ! Append colons
FILEN = .FILEN + 2; ! New node name length
end;
if P_NARG (TMP)
then
X: begin
case .TMP from $CMOFI to $CMFLD of
set
[$CMOFI]: P_OFIL (TMP);
[$CMFIL]: P_FILE (TMP);
[$CMFLD]: P_FLD (TMP);
[OUTRANGE]: leave X;
tes;
TMP2 = ch$ptr(.TMP+1);
LEN = CH$MIN(.TMP2,(80-.FILEN));
ch$move (.LEN,.TMP2,.TMP1); ! Append file
FILEN = .FILEN + .LEN;
CVLTU (.FIPTR, .FILEN); ! Convert file name to upper case
end;
end;
.POINTER = .FIPTR; ! Update new file name pointer
.LENGTH = .FILEN; ! Update new file name length
end;
return $TRUE;
end; ! End of NM_REMOTE
%routine ('NM_PARMS', ENTITY_TYPE, CLEAR_PURGE) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! Current position within the PB portion of the MS block.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
literal
MAX_TEMP = 6;
map
ENTITY_TYPE : FULL_ENTITY;
local
PARM_NO, ! Parameter number
PARM_TYPE, ! Parsed parameter type
EBUF: CH$SEQUENCE (25,8),
TEMP: vector[MAX_TEMP];
! Process any parameters supplied
while not P_CFM (PARM_TYPE) ! Get type of next parsed item
do begin ! As long as not at end of command
incr I from 0 to (MAX_TEMP-1)
do TEMP[.I] = 0; ! Reset data vector
case .PARM_TYPE from $CMKEY to $CMNOD of
set
[$CMKEY]: ! %O'00' Keyword
begin
local VALKEY;
! Special case for keywords - Could be either second part of
! parameter keyword or value
PARM_NO = 0; ! Initialize parameter number
VALKEY = $FALSE; ! Reset recording flag
while (P_KEYW (PARM_TYPE)) ! Get the keyword code
do begin
if (.PARM_TYPE<16,1> and ! Known qualifier keyword ?
(.PARM_TYPE neq P$ALL))! but not ALL
then begin ! Yes,
VALKEY = $TRUE; ! Record this parameter now
selectone .PARM_NO of
set ! Process KNOWN qualifiers
[E$PKNW]: ! Special case for KNOWN EVENTS
begin
TEMP = 3^14; ! Indicate known events
NM_EVENT (TEMP, EBUF); ! Parse event list
exitloop;
end;
[otherwise]: ! Other KNOWN qualifiers
begin ! Adjust qualifier parameter number
PARM_TYPE<16,1> = 0; ! Clear known keyword bit
PARM_NO = .PARM_NO + .PARM_TYPE;
TEMP = KNOWN_; ! Set KNOWN indicator
end;
tes;
end
else begin
if .PARM_TYPE<17,1> ! Value keyword ?
then begin ! Yes,
VALKEY = $TRUE; ! Record this parameter now
! If function is CLEAR/PURGE, then this is
! actually a parameter keyword, not a value
! keyword. Clear value keyword and use it
! to update parameter number
if not .CLEAR_PURGE
then TEMP = .PARM_TYPE
else begin
PARM_TYPE<17,1> = 0;
PARM_NO = .PARM_NO + .PARM_TYPE;
TEMP = 0;
end;
exitloop;
end
else begin ! Add parameter values
PARM_NO = .PARM_NO + .PARM_TYPE;
if .PARM_TYPE eql P$ALL
then begin
VALKEY = $TRUE;
exitloop;
end;
end;
end;
end;
if .VALKEY
then NICE_PARM (%O'0', ! Assemble value keyword parameters
TEMP,
.CLEAR_PURGE,
.PARM_NO,
.ENTITY_TYPE);
end;
[$CMNUM, ! %O'01' Number parsed by $NUMBER
$CMNUX]: ! %O'24' Number parsed by $DIGIT
begin
local TMP, LEN;
P_NUM (TEMP); ! Get the first numeric value
NM_NUMBER (TEMP, EBUF); ! Parse possible range or list
NICE_PARM (%O'0',
TEMP,
.CLEAR_PURGE,
.PARM_NO,
.ENTITY_TYPE);
end;
[$CMIFI, ! %O'04' Input file specification
$CMOFI, ! %O'05' Output file specification
$CMFIL]: ! %O'06' File specification
begin
local FDB;
case .PARM_TYPE from $CMIFI to $CMFIL of
set ! Get file specification address
[$CMIFI]: P_IFIL (FDB);
[$CMOFI]: P_OFIL (FDB);
[$CMFIL]: P_FILE (FDB);
tes;
! The value returned is the address of a GALAXY formatted file
! descriptor block. The first word contains the number of words
! in the block in the left half.
TEMP = ch$ptr (.FDB+1);
NICE_PARM (CH$LEN(.TEMP), ! Length of ASCIZ string
TEMP,
.CLEAR_PURGE,
.PARM_NO,
.ENTITY_TYPE);
end;
[$CMFLD]: ! %O'07' Field
begin
local TMP, LENGTH,
FILE: CH$SEQUENCE (80,8);
P_FLD (TEMP); ! Get address of string
TEMP = ch$ptr (.TEMP+1); ! Make pointer to it
LENGTH = CH$LEN (.TEMP); ! Length of field
NM_REMOTE (TEMP, LENGTH, FILE);
NICE_PARM (.LENGTH, ! Write NICE message
TEMP,
.CLEAR_PURGE,
.PARM_NO,
.ENTITY_TYPE);
end;
[$CMDEV]: ! %O'16' Device
begin
P_DEV (TEMP); ! Get address of string
TEMP = ch$ptr(.TEMP+1); ! Make pointer to it
NICE_PARM (CH$LEN(.TEMP), ! Length of ASCIZ string
TEMP,
.CLEAR_PURGE,
.PARM_NO,
.ENTITY_TYPE);
end;
[$CMQST]: ! %O'21' Quoted string
begin
P_QSTR (TEMP); ! Get address of string
TEMP = ch$ptr(.TEMP+1); ! Make pointer to it
NICE_PARM (CH$LEN(.TEMP), ! Length of ASCIZ string
TEMP,
.CLEAR_PURGE,
.PARM_NO,
.ENTITY_TYPE);
end;
[$CMNOD]: ! %O'26' Node name
begin
literal FILE_NAME_LENGTH = 80; ! Length of node name storage
local LENGTH, TMP,
NODE: CH$SEQUENCE (FILE_NAME_LENGTH,8);
P_NODE (TEMP); ! Get node name
LENGTH = CH$MIN (ch$ptr (TEMP,,6), 6); ! Maximum length
CVSTA (.LENGTH, ! Convert node name to ASCII
.LENGTH,
.TEMP,
ch$ptr (NODE,,8));
if P_NARG (TMP)
then begin
selectone .TMP of
set ! Remote file name: if followed by
[$CMFIL, ! a file name, then it is a TOPS-20
$CMFLD]: ! a field, then it is a foreign
begin
local LEN, FP, NP;
if .TMP eql $CMFLD ! Get file name
then P_FLD (TMP)
else P_FILE (TMP);
FP = ch$ptr (.TMP+1);
NP = ch$ptr (NODE,.LENGTH,8); ! Pointer to node name
LEN = CH$MIN (.FP,FILE_NAME_LENGTH-(.LENGTH+2));
NP = ch$move (2, ! Append colons to node
CH$ASCIZ('::'),
.NP);
ch$move (.LEN,.FP,.NP); ! Append file name to node
LENGTH = .LENGTH + .LEN + 2; ! File name length
end;
[otherwise]: ! Otherwise, it is just another node
tes;
end;
TEMP = ch$ptr (NODE,,8);
NICE_PARM (.LENGTH, ! Write NICE node name parameter
TEMP,
.CLEAR_PURGE,
.PARM_NO,
.ENTITY_TYPE);
end;
[inrange,
outrange]:
$INTERNAL_ERROR$ ('Unexpected COMND jsys function code');
tes;
end;
NCP$QUEUE_REQUEST (0); ! Queue the NICE request message
return $TRUE;
end; ! End of NM_PARMS
%routine ('NCP_READ', TYPE) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Performs common semantic processing for NCP SHOW and LIST command.
!
! FORMAL PARAMETERS
!
! TYPE - Type of parameters to be read; PERMANENT or VOLATILE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
local
TEMP,
PARAMETER,
OPTION_BYTE,
ENTITY_TYPE : FULL_ENTITY,
FORMAT,
LENGTH,
ENTITY_POINTER;
TEMP = NM_ENTITY (ENTITY_TYPE, ! Get entity field from command
FORMAT,
LENGTH,
ENTITY_POINTER);
if .TEMP
then begin
if .ENTITY_TYPE eql 8 ! Is it QUEUE entity ?
then SHOW_QUEUE () ! Process a SHOW QUEUE
else begin
if (TEMP = READ_OPTION (.TYPE, .ENTITY_TYPE, OPTION_BYTE))
then begin
NICE_OPTION (.OPTION_BYTE); ! Write option byte
! Build NICE read information message
selectone .ENTITY_TYPE[ENTITY_MAIN] of
set
[ENTITY_NODE]:
begin ! Special case for NODE id
local NODE_STRING: ch$sequence (6,8);
CVSTA (.FORMAT, ! Convert node id to string
.LENGTH,
.ENTITY_POINTER,
ch$ptr (NODE_STRING,,8));
NICE_ENTITY (.FORMAT, ! Write entity id field
.LENGTH,
ch$ptr (NODE_STRING,,8));
end;
[ENTITY_AREA]:
begin
local AREA_STRING: ch$sequence (2);
ch$wchar (.ENTITY_POINTER, ch$ptr (AREA_STRING,,8)); ! Put the area id into a string
NICE_ENTITY (.FORMAT, ! Write the entity id field
.LENGTH,
ch$ptr (AREA_STRING,,8));
end;
[otherwise]:
NICE_ENTITY (.FORMAT, ! Write entity id field
.LENGTH,
.ENTITY_POINTER);
tes;
if not P_CFM (PARAMETER) ! Parse remaining parameters
then NM_PARMS (.ENTITY_TYPE, 0)
else begin
DEFAULT_QUALIFIER (.ENTITY_TYPE, ! Set up default
.ENTITY_POINTER, ! qualifiers
.LENGTH);
NCP$QUEUE_REQUEST (0); ! Queue NICE request message
end;
end;
end;
end;
return .TEMP;
end; ! End of NCP_READ
%routine ('DEFAULT_QUALIFIER', ENTITY, POINTER, LENGTH) : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! ENTITY Entity type code
! POINTER Pointer to entity id string
! LENGTH Length of the entity id string
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
local
PARAMETER;
selectone .ENTITY of
set
[ENTITY_LOGGING]: ! LOGGING entity
begin
PARAMETER = 200; ! SINK NODE
PUTW (PARAMETER, REQ[RB_NICE_POINTER]);
incr I from 1 to 3 ! Make it EXECUTOR node
do ch$wchar_a (0, REQ[RB_NICE_POINTER]);
REQ[RB_NICE_LENGTH] = .REQ[RB_NICE_LENGTH] + 5;
end;
[otherwise]: ! No default qualifiers for others
0;
tes;
return;
end; ! End of DEFAULT_QUALIFIER
%routine ('SHOW_QUEUE') : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
literal
TEXT_BUFFER_LENGTH = 24*80, ! Length of text buffer in characters
TEXT_BUFFER_SIZE = ! Size in fullwords
ch$allocation (TEXT_BUFFER_LENGTH),
TEXT_BUFFER_ALLOCATION = ! Size of allocation in units
TEXT_BUFFER_SIZE * %upval,
TXT_BFR_SZ = 24*80; ! A screenful
local
TXT_BFR, ! Text buffer address for response
HDR, ! Flags whether first response header
REQ_BLOCK_ADDR, ! Address of NML request block
REQ_DATA, ! Address of Request data
REQ_NO; ! NML Request number
map
REQ_BLOCK_ADDR: ref REQUEST_BLOCK; ! Make fields addressable
map
REQ_DATA: ref XCTR_BLOCK; ! Make fields available
TXT_BFR = NMU$MEMORY_GET (TXT_BFR_SZ); ! Get text buffer
REQ_NO = 0; ! Initialize to start of queues
HDR = 0; ! Initially no header sent
if NML$REQUEST_SHOW (REQ_NO,REQ_BLOCK_ADDR)
then begin
do begin
TEXT_PTR = ch$ptr(.TXT_BFR); ! Set up pointer to text
REQ_DATA = .REQ_BLOCK_ADDR[RB_DATA]; ! Special data
if .REQ_BLOCK_ADDR[RB_STATE] eql RB$WAITING
then $NMU$TEXT (TEXT_PTR,
TXT_BFR_SZ,
$NML$TEXT ('Request # %D Queued%N'),
.REQ_BLOCK_ADDR[RB_NUMBER])
else if .REQ_BLOCK_ADDR[RB_STATE] eql RB$ACTIVE
or .REQ_BLOCK_ADDR[RB_STATE] eql RB$MORE
then $NMU$TEXT (TEXT_PTR,
TXT_BFR_SZ,
$NML$TEXT ('Request # %D Active%N'),
.REQ_BLOCK_ADDR[RB_NUMBER])
else if .REQ_BLOCK_ADDR[RB_STATE] eql RB$DONE
then $NMU$TEXT (TEXT_PTR,
TXT_BFR_SZ,
$NML$TEXT ('Request # %D Complete%N'),
.REQ_BLOCK_ADDR[RB_NUMBER])
%( N.B - The following situation should be changed
to an internal error after testing is
completed. )%
else $NMU$TEXT (TEXT_PTR,
TXT_BFR_SZ,
$NML$TEXT ('Request # %D Unknown State%N'),
.REQ_BLOCK_ADDR[RB_NUMBER]);
if .REQ_BLOCK_ADDR[RB_TYPE] eql RT$LOCAL
then $NMU$TEXT (TEXT_PTR,
TXT_BFR_SZ,
$NML$TEXT (', Local%N'))
else if .REQ_BLOCK_ADDR[RB_TYPE] eql RT$REMOTE
then $NMU$TEXT (TEXT_PTR,
TXT_BFR_SZ,
$NML$TEXT (', Remote%N'))
%( N.B - The following situation should be changed
to an internal error after testing is
completed. )%
else $NMU$TEXT (TEXT_PTR,
TXT_BFR_SZ,
$NML$TEXT (', Unknown Type%N'));
if .REQ_BLOCK_ADDR[RB_EXECUTOR] neq 0
then begin
local
LEN,
ADR,
PTR,
PAT;
PTR = ch$ptr(.REQ_BLOCK_ADDR[RB_EXECUTOR],,8);
ADR = GETW (PTR); ! Get node address
if .ADR neq 0
then begin ! Node address
local
AREA,
NODE;
if (AREA = .ADR<10,6>) eql 0
then begin
local TEMP;
TEMP = NMU$NETWORK_LOCAL();
TEMP = GETW (TEMP);
AREA = .TEMP<10,6>;
end;
NODE = .ADR<0,10>;
LEN = GETB (PTR); ! Get I-length
if .LEN eql 0
then begin
PAT = CH$ASCIZ(
$NML$TEXT (', Executor = %D.%D %N'));
$NMU$TEXT (TEXT_PTR,
TXT_BFR_SZ,
.PAT,
.AREA,
.NODE);
end
else begin
PAT = CH$ASCIZ(
$NML$TEXT (', Executor = %D.%D (%#A) %N'));
$NMU$TEXT (TEXT_PTR,
TXT_BFR_SZ,
.PAT,
.AREA,
.NODE,
.LEN,
.PTR);
end;
end
else begin ! Node name
PAT = CH$ASCIZ($NML$TEXT (', Executor = (%#A) %N'));
LEN = GETB (PTR); ! Get I-length
$NMU$TEXT (TEXT_PTR,
TXT_BFR_SZ,
.PAT,
.LEN,
.PTR);
end;
end;
if .REQ_BLOCK_ADDR[RB_SOURCE] neq 0
then begin
local
LEN,
PTR,
PAT;
PTR = ch$ptr(.REQ_BLOCK_ADDR[RB_SOURCE],,8);
if (LEN = GETB (PTR)) eql 0
then begin ! Node address
PAT = CH$ASCIZ($NML$TEXT (', Source = %D %N'));
! removed at edit 20 PAT = CH$ASCIZ($NML$TEXT (', Source = %D %/%/%N'));
PTR = GETW (PTR);
$NMU$TEXT (TEXT_PTR,
TXT_BFR_SZ,
.PAT,
.PTR);
end
else begin ! Node name
PAT = CH$ASCIZ($NML$TEXT (', Source = (%#A) %N'));
! removed at edit 20 PAT = CH$ASCIZ($NML$TEXT (', Source = (%#A) %/%/%N'));
$NMU$TEXT (TEXT_PTR,
TXT_BFR_SZ,
.PAT,
.LEN,
.PTR);
end;
end;
%debug (NCP_NICE_VALIDATION,
(begin
$NMU$TEXT (TEXT_PTR, TXT_BFR_SZ,
'%/[NICE Request Message]%/%N');
PUTBUF (TEXT_PTR, 0,
.REQ_BLOCK_ADDR[RB_NICE],
.REQ_BLOCK_ADDR[RB_NICE_LENGTH]);
end));
$NMU$TEXT (TEXT_PTR, ! Terminate with CR/LF and a
TXT_BFR_SZ, ! null byte
'%/') ;
if .REQ_BLOCK_ADDR[RB_DATA_ALLOCATION] neq 0 ! Release data block
then NMU$MEMORY_RELEASE (.REQ_BLOCK_ADDR[RB_DATA],
.REQ_BLOCK_ADDR[RB_DATA_ALLOCATION]);
NMU$MEMORY_RELEASE (.REQ_BLOCK_ADDR, ! Release the copy of request
REQUEST_BLOCK_ALLOCATION);
end
while begin
if NML$REQUEST_SHOW (REQ_NO,REQ_BLOCK_ADDR)
then begin ! Send first or later partial response
NCP$SEND_RESPONSE ((if not .HDR
then (HDR = 1; 1)
else 2),
ch$ptr(.TXT_BFR),
.ACK_COD,
0);
$TRUE
end
else $FALSE
end;
NCP$SEND_RESPONSE ((if .HDR ! Final or only response
then 3
else 0),
ch$ptr(.TXT_BFR),
.ACK_COD,
0);
end
else begin
TEXT_PTR = ch$ptr(.TXT_BFR);
$NMU$TEXT (TEXT_PTR,
TXT_BFR_SZ,
$NML$TEXT ('[The queue is empty]'));
NCP$SEND_RESPONSE (0,ch$ptr(.TXT_BFR),.ACK_COD, 0);
end;
NMU$MEMORY_RELEASE (.TXT_BFR,TXT_BFR_SZ); ! Release buffer
!
! Now we have to clean up and release the REQuest block, because this
! command never calls its completion routine
!
NMU$MEMORY_RELEASE (.REQ [RB_NICE], NICE_BUFFER_ALLOCATION);
NMU$MEMORY_RELEASE (.REQ [RB_DATA], EXECUTOR_BLOCK_ALLOCATION);
NMU$MEMORY_RELEASE (.REQ, REQUEST_BLOCK_ALLOCATION);
end; ! End of SHOW_QUEUE
%routine ('NCP_CHANGE', TYPE, OP) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Performs common semantic processing for NCP SET, DEFINE,
! CLEAR, or PURGE commands.
!
! FORMAL PARAMETERS
!
! TYPE - The type of parameters to change.
! 0 = VOLATILE
! 1 = PERMANENT
!
! OP - The operation to be performed.
! 0 = SET/DEFINE
! 1 = CLEAR/PURGE
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
local
TEMP,
OPTION_BYTE,
ENTITY_TYPE : FULL_ENTITY,
FORMAT,
LENGTH,
ENTITY_POINTER,
NODE_STRING: CH$SEQUENCE(6,8); ! Storage for node name
if not (TEMP = NM_ENTITY (ENTITY_TYPE, ! Get entity field from command
FORMAT,
LENGTH,
ENTITY_POINTER))
then return .TEMP; ! Failed
OPTION_BYTE = ((.TYPE ^ 7) or ! Change volatile/permanent parameters
(.OP ^ 6) or ! Set/Define parameters
(.ENTITY_TYPE[ENTITY_MAIN]));
NICE_OPTION (.OPTION_BYTE); ! Write option byte
if .ENTITY_TYPE[ENTITY_MAIN] eqlu ENTITY_NODE
then begin
if (.LENGTH eql 2) and ! Changing an EXECUTOR ?
(.ENTITY_POINTER eql 0)
then begin
literal
TEXT_BUFFER_LENGTH = 24*80, ! Length of text buffer in characters
TEXT_BUFFER_SIZE = ! Size in fullwords
ch$allocation (TEXT_BUFFER_LENGTH),
TEXT_BUFFER_ALLOCATION = ! Size of allocation in units
TEXT_BUFFER_SIZE * %upval,
TXT_BFR_SZ = 24*80; ! A screenful
local
TXT_BFR; ! Text buffer address for response
P_KEYW (TEMP); ! Get the next keyword
if .TEMP eql N$XNOD ! Check for 'NODE'
then begin ! Perform CHANGE EXECUTOR function
if (if P_NODE (ENTITY_POINTER)
then begin ! Node name
FORMAT = ! Length & format are less than six
LENGTH = CH$MIN(ch$ptr(ENTITY_POINTER,,6), 6);
$TRUE
end
else if P_NUM (ENTITY_POINTER)
then begin ! Node number
FORMAT = 0;
LENGTH = 2;
$TRUE
end
else $FALSE)
then CVSTA (.FORMAT, ! Convert executor node id to string
.LENGTH,
.ENTITY_POINTER,
ch$ptr(NODE_STRING,,8));
TXT_BFR = NMU$MEMORY_GET (TXT_BFR_SZ); ! Get text buffer
TEXT_PTR = ch$ptr(.TXT_BFR); ! Set up pointer to text
case (.TYPE ^ 1 or .OP) from %B'00' to %B'11' of
set
[%B'00']: ! Perform SET EXECUTOR
begin
SET_XCTR (.FORMAT,
ch$ptr(NODE_STRING,,8));
$NMU$TEXT (TEXT_PTR,
TXT_BFR_SZ,
$NML$TEXT ('Set Executor Complete'));
end;
[%B'01']: ! Perform CLEAR EXECUTOR
begin
CLEAR_XCTR ();
$NMU$TEXT (TEXT_PTR,
TXT_BFR_SZ,
$NML$TEXT ('Clear Executor Complete'));
end;
%( N.B. - The other cases, DEFINE EXECUTOR and
PURGE EXECUTOR will have to be handled eventually. )%
[%B'10']: ! Perform DEFINE EXECUTOR
begin
$NMU$TEXT (TEXT_PTR,
TXT_BFR_SZ,
$NML$TEXT ('Define Executor is not implemented'));
end;
[%B'11']: ! Perform PURGE EXECUTOR
begin
$NMU$TEXT (TEXT_PTR,
TXT_BFR_SZ,
$NML$TEXT ('Purge Executor is not implemented'));
end;
tes;
%( N.B. - ***** Format and send a confirmation
message back to the operator. )%
NCP$SEND_RESPONSE (0,ch$ptr(.TXT_BFR),.ACK_COD, 0);
NMU$MEMORY_RELEASE (.TXT_BFR,TXT_BFR_SZ); ! Release buffer
return $TRUE
end ! ------End of EXECUTOR NODE block
else begin ! Dummy up an entity id for EXECUTOR
P_PREV (); ! Back up past current keyword
CVSTA (0, ! Convert node name to ASCII string
2,
0,
ch$ptr(NODE_STRING,,8)) ;
NICE_ENTITY (.FORMAT, ! Write entity id field
.LENGTH,
ch$ptr(NODE_STRING,,8));
end;
end
else begin
CVSTA (.FORMAT, ! Convert node id to string
.LENGTH,
.ENTITY_POINTER,
ch$ptr(NODE_STRING,,8));
NICE_ENTITY (.FORMAT, ! Write entity id field
.LENGTH,
ch$ptr(NODE_STRING,,8));
end;
end
else NICE_ENTITY (.FORMAT, ! Write entity field
.LENGTH,
.ENTITY_POINTER);
NM_PARMS (.ENTITY_TYPE,.OP) ! Process parameters
end; ! End of NCP_CHANGE
%routine ('NCP_BOOT') =
!++
! FUNCTIONAL DESCRIPTION:
!
! Performs semantic processing for the boot class commands,
! LOAD, DUMP, and TRIGGER.
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
local
RTN_COD,
OPTION_BYTE: block [1] field (BOOT_OPTIONS),
ENTITY_TYPE : FULL_ENTITY,
FORMAT,
LENGTH,
ENTITY_POINTER;
!
! Process the entity portion of the NCP command.
!
RTN_COD = NM_ENTITY (ENTITY_TYPE, ! Get entity field from command
FORMAT,
LENGTH,
ENTITY_POINTER);
if not .RTN_COD ! Error return if invalid entity
then return .RTN_COD;
!
! Format the option byte and entity id portion of the NICE request.
!
case .ENTITY_TYPE[ENTITY_MAIN] from ENTITY_LO to ENTITY_HI of
set
[ENTITY_NODE]:
begin
local
NODE_STRING: CH$SEQUENCE(6,8); ! Storage for node name
OPTION_BYTE[BO_ENTITY_TYPE] = ENTITY_NODE; ! Node id option
CVSTA (.FORMAT, ! Convert node id to string
.LENGTH,
.ENTITY_POINTER,
ch$ptr(NODE_STRING,,8));
ENTITY_POINTER = ch$ptr(NODE_STRING,,8);
NICE_OPTION (.OPTION_BYTE); ! Write option byte
NICE_ENTITY (.FORMAT, ! Write entity id field
.LENGTH,
.ENTITY_POINTER);
RTN_COD = $TRUE;
end;
[ENTITY_CIRCUIT]:
begin
OPTION_BYTE[BO_ENTITY_TYPE] = ENTITY_CIRCUIT; ! Circuit id option
NICE_OPTION (.OPTION_BYTE); ! Write option byte
NICE_ENTITY (.FORMAT, ! Write entity id field
.LENGTH,
.ENTITY_POINTER);
RTN_COD = $TRUE;
end;
[inrange,outrange]:
$INTERNAL_ERROR$ ('Invalid entity keyword for BOOT');
tes;
if not .RTN_COD
then return .RTN_COD;
! Force NM_PARMS to interpret all parameters as NODE
! entity parameters.
RTN_COD = NM_PARMS (ENTITY_NODE,0); ! Process any parameters
return .RTN_COD
end; ! End of NCP_BOOT
%routine ('CVSTA', FORMAT, LENGTH, NODE_ID, NOD_PTR) : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! Converts parsed node id to usable format.
!
! FORMAL PARAMETERS
!
! FORMAT - A value which represents the NODE entity format type.
!
! LENGTH - A value which represents the length of the node id.
!
! NODE_ID - A value which represents either a SIXBIT node name or
! a node number, depending on the contents of FORMAT.
!
! NOD_PTR - A character sequence pointer to the destination where
! the node id string will be written.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
if .FORMAT eql 0 ! NODE in address format, so just
then PUTW (NODE_ID,NOD_PTR) ! copy it as is
else if .FORMAT gtr 0 ! NODE in name format, so convert
then ch$translate (SIXTAB,
.LENGTH,
ch$ptr(NODE_ID,,6), ! Source SIXBIT string
0,
.LENGTH,
.NOD_PTR); ! Destination ASCII string
end; ! End of CVSTA
%global_routine ('CVLTU', POINTER, LENGTH) : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! Converts an ASCII character string from mixed (lower and upper) case
! text to all upper case text.
!
! FORMAL PARAMETERS
!
! POINTER - A character sequence pointer to the source ASCII string.
! LENGTH - The length of the ASCII string.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
bind ! Lower to upper case translation table
UPCASE = ch$transtable (rep 32 of (0),
CH$EXPLODE (' !"#$%&'), %c'''',
CH$EXPLODE ('()*+,-./0123456789'),
CH$EXPLODE (':;<=>?@ABCDEFGHIJK'),
CH$EXPLODE ('LMNOPQRSTUVWXYZ[\]'),
CH$EXPLODE ('^_`ABCDEFGHIJKLMNO'),
CH$EXPLODE ('PQRSTUVWXYZ{|}~'),
%O'177');
ch$translate (UPCASE, ! Translation table
.LENGTH, ! String length
.POINTER, ! Source string
0, ! Fill with nulls
.LENGTH,
.POINTER); ! Destination string
end; ! End of CVLTU
%routine ('CVATH', ASC_PTR, ASC_LTH, BP8_ADR) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Converts an ASCII character string, representing a hexadecimal
! number, to a string of 8 bit bytes. The ASCII string may be of
! arbitrary length, with two ASCII characters, in the range
! 0-9 and A-F only, being converted to one 8 bit byte in the
! output string. If the length of the ASCII string is an odd
! number then the first 8 bit byte written will have the first
! 4 bits set to zero. The pointer to the output string buffer
! will be point to the next available byte on return.
!
! FORMAL PARAMETERS
!
! ASC_PTR - A character sequence pointer to an ASCII hex string.
! ASC_LTH - The length of the ASCII string.
! 8BP_PTR - The address of a pointer to an 8 bit character sequence
! buffer where the output will be written.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! $TRUE, if the input ASCII string was a valid hex string.
! $FALSE, if a character other than 0-9 or A-F was encountered.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
local
SRC_LEN, ! Length of source string
SRC_PTR, ! Pointer to tail of source string
HEX_VAL; ! 8 bit HEX value
! Translate the ASCII string to HEX values. Invalid characters are
! replaced by -1. The ASCII characters which represent HEX digits
! are replaced by the HEX digit value.
SRC_LEN = .ASC_LTH;
SRC_PTR = ch$translate (HEXTAB, .SRC_LEN, .ASC_PTR, -1, .SRC_LEN, .ASC_PTR);
if not ch$fail (ch$find_ch (.SRC_LEN, .ASC_PTR, -1))
then return $FALSE;
HEX_VAL = 0; ! Initialize to zero
while (SRC_LEN = .SRC_LEN - 2) geq 0
do begin
SRC_PTR = ch$plus (.SRC_PTR, -2);
HEX_VAL<4,4> = ch$rchar_a (SRC_PTR); ! Get hi order HEX bits
HEX_VAL<0,4> = ch$rchar_a (SRC_PTR); ! Get lo order HEX bits
SRC_PTR = ch$plus (.SRC_PTR, -2);
ch$wchar_a (.HEX_VAL,.BP8_ADR); ! Write a HEX byte
end;
if .SRC_LEN ! Is it an odd length ASCII string?
then begin ! Assume hi order 4 bits zero
SRC_PTR = ch$plus (.SRC_PTR, -1);
HEX_VAL = ch$rchar_a (SRC_PTR);
ch$wchar_a (.HEX_VAL,.BP8_ADR); ! Write first HEX byte
end;
return $TRUE
end; ! End of CVATH
%routine ('CVATHI', ASC_PTR, ASC_LTH, BP8_ADR) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Converts an ASCII character string, representing a hexadecimal
! numeric string, to a string of 8 bit bytes. The ASCII string may
! be of arbitrary length, with two ASCII characters, in the range
! 0-9 and A-F only, being converted to one 8 bit byte in the
! output string. If the length of the ASCII string is an odd
! number then the first 8 bit byte written will have the first
! 4 bits set to zero. The pointer to the output string buffer
! will be point to the next available byte on return.
!
! FORMAL PARAMETERS
!
! ASC_PTR - A character sequence pointer to an ASCII hex string.
! ASC_LTH - The length of the ASCII string.
! 8BP_PTR - The address of a pointer to an 8 bit character sequence
! buffer where the output will be written.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! $TRUE, if the input ASCII string was a valid hex string.
! $FALSE, if a character other than 0-9 or A-F was encountered.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
local
SRC_LEN, ! Length of source string
SRC_PTR, ! Pointer to tail of source string
HEX_VAL; ! 8 bit HEX value
! Translate the ASCII string to HEX values. Invalid characters are
! replaced by -1. The ASCII characters which represent HEX digits
! are replaced by the HEX digit value.
SRC_LEN = .ASC_LTH;
ch$translate (HEXTAB, .SRC_LEN, .ASC_PTR, -1, .SRC_LEN, .ASC_PTR);
if not ch$fail (ch$find_ch (.SRC_LEN, .ASC_PTR, -1))
then return $FALSE;
HEX_VAL = 0; ! Initialize to zero
SRC_PTR = .ASC_PTR;
if .SRC_LEN ! Is it an odd length ASCII string?
and (.SRC_LEN gtr 0) ! Make sure it is not negative length
then begin ! Assume hi order 4 bits zero
HEX_VAL<0,4> = ch$rchar_a (SRC_PTR);
ch$wchar_a (.HEX_VAL,.BP8_ADR); ! Write first HEX byte
SRC_LEN = .SRC_LEN - 1;
end;
while (SRC_LEN = .SRC_LEN - 2) geq 0
do begin
HEX_VAL<4,4> = ch$rchar_a (SRC_PTR); ! Get hi order HEX bits
HEX_VAL<0,4> = ch$rchar_a (SRC_PTR); ! Get lo order HEX bits
ch$wchar_a (.HEX_VAL,.BP8_ADR); ! Write a HEX byte
end;
return $TRUE
end; ! End of CVATHI
%routine ('REMOVE_DASHES', INPUT_PTR, INPUT_LENGTH, OUTPUT_PTR) =
!++
!
! Functional description:
!
! This function removes all dashes from a string. It takes an ETHERNET
! address as input with dashes and outputs a string with the dashes
! removed. No syntax checks are made.
!
! Formal parameters:
!
! INPUT_PTR Character pointer to input string
! INPUT_LENGTH Length of input string
! OUTPUT_PTR Character pointer to output string
!
! Routine value:
!
! Returns length of output string
!
!--
begin
local
OUTPUT_LENGTH, ! Output length
COUNT, ! Input count
CHR; ! Current character
COUNT = .INPUT_LENGTH; ! Set up count of chars to do
OUTPUT_LENGTH = 0; ! No output chars yet
! Loop over input string
while (COUNT = .COUNT - 1) geq 0
do begin
CHR = ch$rchar_a (INPUT_PTR); ! Read next char
if .CHR neq %C'-'
then begin
ch$wchar_a (.CHR, OUTPUT_PTR);
OUTPUT_LENGTH = .OUTPUT_LENGTH + 1;
end;
end;
return .OUTPUT_LENGTH; ! Return the output string length
end; ! End of REMOVE_DASHES
%routine ('SET_XCTR', FORMAT, NODE_PTR) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Performs the SET EXECUTOR NODE node-id command.
!
! FORMAL PARAMETERS
!
! FORMAT - The node entity format byte.
! 0 = NODE address
! >0 = NODE name
!
! NODE_PTR - Pointer to node entity id.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
local
USR_LEN,
ACT_LEN,
PWD_LEN,
TEMP,
XCTR: ref block[XCTR_SZ] field(XCTR_FIELDS);
!
! Check to see if this OPERATOR has previously specified an EXECUTOR.
! If so, reuse that block else allocate a new executor block and place
! in the data base.
!
if (XCTR = NMU$QUEUE_SCAN (XCTR_NOD_Q,.ACK_COD,SCAN_XCTR_Q)) eql 0
then begin ! Entry not in queue
XCTR = NMU$MEMORY_GET (XCTR_SZ); ! Allocate storage for EXECUTOR
XCTR[OPR_ID] = .ACK_COD; ! Copy operator identifier
NMU$QUEUE_INSERT (XCTR_NOD_Q,.XCTR) ! Insert it
end;
!
! Copy the new EXECUTOR node id into the block in the data base.
!
TEMP = ch$ptr(XCTR[NOD_ID],,8); ! Pointer to node id
if .FORMAT eql 0 ! Node address format ?
then begin
TEMP = ch$move(2, ! Copy node address
.NODE_PTR,
.TEMP);
PUTB (0,TEMP); ! Write I-length of zero
end
else begin
ch$wchar_a (0,TEMP); ! Write node address of zero
ch$wchar_a (0,TEMP);
ch$wchar_a (.FORMAT,TEMP); ! Write I-field length
ch$move (.FORMAT, ! Copy node name string
.NODE_PTR,
.TEMP);
end;
!
! Process any access control info specified in the command and copy it into
! the EXECUTOR block. If an EXECUTOR had been previously specified and access
! control info was specified then default to any access control previously
! specified in the absence of any new access control.
!
ACCESS_CONTROL (ch$ptr(XCTR[USR_ID],1),USR_LEN, ! Get access control info
ch$ptr(XCTR[ACTSTR],1),ACT_LEN,
ch$ptr(XCTR[PWDSTR],1),PWD_LEN);
ch$wchar(.USR_LEN,ch$ptr(XCTR[USR_ID])); ! Write length byte
ch$wchar(.ACT_LEN,ch$ptr(XCTR[ACTSTR])); ! Write length byte
ch$wchar(.PWD_LEN,ch$ptr(XCTR[PWDSTR])); ! Write length byte
return 1;
end; ! End of SET_XCTR
%routine ('CLEAR_XCTR') =
!++
! FUNCTIONAL DESCRIPTION:
!
! Performs the CLEAR EXECUTOR NODE command.
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
local
XCTR: ref block[XCTR_SZ] field(XCTR_FIELDS);
if (XCTR = NMU$QUEUE_SCAN (XCTR_NOD_Q,.ACK_COD,SCAN_XCTR_Q)) neq 0
then begin ! An EXECUTOR was previously set
if not NMU$QUEUE_EXTRACT (XCTR_NOD_Q,.XCTR) ! Delete from data base
then $INTERNAL_ERROR$ ('EXECUTOR was on queue but could not be extracted');
end;
return 1;
end; ! End of CLEAR_XCTR
%routine ('ACCESS_CONTROL', USR_PTR, USR_LEN, ACT_PTR, ACT_LEN, PWD_PTR, PWD_LEN) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Performs semantic processing of access control fields in
! SET EXECUTOR and LOOP NODE commands, and TELL prefix.
!
! FORMAL PARAMETERS
!
!
!
! IMPLICIT INPUTS
!
! Current position within the PB portion of the MS block.
!
! ROUTINE VALUE: Returns keyword code of next keyword, if exists.
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
local
TEMP; ! Local work variable
.USR_LEN = .PWD_LEN = .ACT_LEN = 0; ! Initialize to indicate no access ctl
while (P_KEYW (TEMP))
do begin
case .TEMP from N$XACT to N$XUSR of
set
[N$XACT]: ! ACCOUNT
begin
if P_FLD (TEMP)
then begin
.ACT_LEN = CH$MIN(ch$ptr(.TEMP+1), 16);
CVLTU (ch$ptr(.TEMP+1), ..ACT_LEN); ! Convert to upper case
.ACT_LEN = QUOTE_FIELD (..ACT_LEN,
ch$ptr(.TEMP+1),
.ACT_PTR);
end
else $INTERNAL_ERROR$ ('Access control field syntax error');
end;
[N$XPWD]: ! PASSWORD
begin
%( N.B. - Note that over the network the password provided
on a connection to a remote server is 8 bit binary. As
implemented here and in the NCP3TB syntax tables only
7 bit ASCII strings are provided. If the full 8 bit
functionality is desired then NCP3TB must be changed
to accept octal triplets, ala, NETPRO; and this code
changed accordingly. )%
if P_FLD (TEMP)
then begin
.PWD_LEN = CH$MIN(ch$ptr(.TEMP+1), 16);
CVLTU (ch$ptr(.TEMP+1), ..PWD_LEN); ! Convert to upper case
.PWD_LEN = QUOTE_FIELD (..PWD_LEN,
ch$ptr(.TEMP+1),
.PWD_PTR);
end
else $INTERNAL_ERROR$ ('Access control field syntax error');
end;
[N$XUSR]: ! USER
begin
if P_FLD (TEMP)
then begin
.USR_LEN = CH$MIN(ch$ptr(.TEMP+1), 16);
CVLTU (ch$ptr(.TEMP+1), ..USR_LEN); ! Convert to upper case
.USR_LEN = QUOTE_FIELD (..USR_LEN,
ch$ptr(.TEMP+1),
.USR_PTR);
end
else $INTERNAL_ERROR$ ('Access control field syntax error');
end;
[inrange,
outrange]: ! Keyword other than access control
begin
return .TEMP; ! Return keyword code, probably command
end;
tes;
end;
return N$XACT ! Return ridiculous keyword code
end; ! End of ACCESS_CONTROL
%routine ('QUOTE_FIELD', N, SPTR, DPTR) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Inserts the TOPS-20 file name quote character (^V) preceding
! any characters other than alphanumerics and dash ('-').
!
! FORMAL PARAMETERS
!
! N - Count of characters to move.
! SPTR - Pointer to source string.
! DPTR - Pointer to destination string.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! The length of the string with embedded control chars.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
local
CH, ! Single character value
LEN;
LEN = .N; ! Initial value
decr REMAINING from .N to 1 ! Loop for each character in string
do begin
CH = ch$rchar_a (SPTR); ! Fetch a character
! If not an alpha, numeric, or hyphen then quote with ^V
%if $TOPS20 %then
if (.CH lss %C'0' and .CH neq %C'-')
or (.CH gtr %C'9' and .CH lss %C'A')
or (.CH gtr %C'Z' and .CH lss %C'a')
or (.CH gtr %C'z')
then begin
ch$wchar_a ((%C'V' - %O'100'),DPTR);
LEN = .LEN + 1;
end;
%fi ! End of %if $TOPS20
ch$wchar_a (.CH,DPTR); ! Write the character
end;
.LEN ! Return adjusted length
end; ! End of QUOTE_FIELD
%routine ('SCAN_XCTR_Q', Q_ADDR, DATA) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Called by NMU$QUEUE_SCAN as an exit routine to determine if a
! particular EXECUTOR block in the EXECUTOR data base list matches
! the operator id being searched for.
!
! FORMAL PARAMETERS
!
! Q_ADDR - Address of the EXECUTOR block in the data base list.
!
! DATA - The operator id being searched for.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! Q_ADDR, if the entry in the data base matches the operator id being
! searched for.
! Zero, otherwise.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
map
Q_ADDR: ref block[XCTR_SZ] field(XCTR_FIELDS);
if .Q_ADDR[OPR_ID] eql .DATA
then return .Q_ADDR ! Found entry being scanned for
else return 0 ! Not found, return zero
end; ! End of SCAN_XCTR_Q
%routine ('READ_OPTION', TYPE, ENTITY_TYPE, ADDRESS) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Builds the option byte for the NICE read information message
! based on the keywords entered on a SHOW or LIST command.
!
! FORMAL PARAMETERS
!
! TYPE A value which represents whether the permanent or
! volatile parameters are to be read.
! 0 = Volatile
! 1 = Permanent.
!
! ENTITY_TYPE The value of the entity type field.
!
! ADDRESS The address of the location where the option byte
! is to be stored.
!
! IMPLICIT INPUTS
!
! Current position within the PB portion of the MS block.
!
! ROUTINE VALUE: True or False.
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
map
ENTITY_TYPE : FULL_ENTITY,
ADDRESS: ref block [1] field (READ_OPTIONS);
local
INFO_TYPE;
!
! The PB is assumed to be pointing past the entity id and at the
! beginning of the parameter keyword.
!
if P_KEYW (INFO_TYPE) ! Get information class
then begin
.ADDRESS = 0; ! Clear the option byte
ADDRESS[RO_PERMANENT] = .TYPE; ! Set the type of parameters to read
ADDRESS[RO_ENTITY_TYPE] = .ENTITY_TYPE[ENTITY_MAIN]; ! Set entity type number
selectone .INFO_TYPE of ! Set information type
set
[$KNCHR]:
ADDRESS[RO_INFO_TYPE] = CHARACTERISTICS_;
[$KNCTR]:
ADDRESS[RO_INFO_TYPE] = COUNTERS_;
[$KNEVT]:
ADDRESS[RO_INFO_TYPE] = EVENTS_;
[$KNSTS]:
ADDRESS[RO_INFO_TYPE] = STATUS_;
[$KNSUM]:
ADDRESS[RO_INFO_TYPE] = SUMMARY_;
[otherwise]: ! Error case
$INTERNAL_ERROR$ ('Invalid parameter keyword');
tes;
return $TRUE; ! Success return
end
else $INTERNAL_ERROR$ ('Invalid message format, expected keyword')
end; ! End of READ_OPTION
%routine ('NICE_INITIALIZE', FUNC_CODE) : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! Initializes NICE message buffer and stores the NICE function
! code, passed as an argument, in the first byte of the NICE
! message.
!
! FORMAL PARAMETERS
!
! Value of the NICE function code as described in NM Functional
! Specification.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE: NONE.
!
! NONE.
!
! SIDE EFFECTS:
!
! REQ[RB_NICE] is set to the address of a dynamically allocated NICE
! message buffer.
!
! REQ[RB_NICE_POINTER] is updated to point to first byte after the NICE
! function code.
!
! REQ[RB_NICE_LENGTH] is updated to reflect message length of 1.
!
! REQ[RB_NICE_FUNCTION] is set to the function code.
!
!--
begin
REQ[RB_NICE_POINTER] = ch$ptr (.REQ[RB_NICE],,8);
REQ[RB_NICE_LENGTH] = 0; ! Point at beginning of NICE buffer
ch$wchar_a (.FUNC_CODE,REQ[RB_NICE_POINTER]); ! Store NICE function code
REQ[RB_NICE_FUNCTION] = .FUNC_CODE; ! Store NICE function code
REQ[RB_NICE_LENGTH] = .REQ[RB_NICE_LENGTH] + 1; ! Bump length count
end; ! End of NICE_INITIALIZE
%routine ('NICE_OPTION', OPTION_BYTE) : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
ch$wchar_a(.OPTION_BYTE,REQ[RB_NICE_POINTER]); ! Write option byte
REQ[RB_NICE_LENGTH] = .REQ[RB_NICE_LENGTH] + 1; ! Bump length
end; ! End of NICE_OPTION
%routine ('NICE_TEST', USER, USR_LEN, PWD, PWD_LEN, ACCT, ACT_LEN, TYPE, FORMAT, LENGTH, ENTITY_POINTER) : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! Builds NICE test message for LOOP command.
!
! FORMAL PARAMETERS
!
! USER - A character pointer to a user id string
! if entity is node.
! USR_LEN - The length of the user id string.
!
! PWD - A character pointer to a password string
! if entity is node.
! PWD_LEN - The length of the password string.
!
! ACCT - A character pointer to an account string
! if entity is node.
! ACT_LEN - The length of the account string.
!
! TYPE - The type of loop test to perform. Corresponds to
! the entity type.
! 0 = NODE.
! 1 = LINE.
!
! FORMAT - A value which represents the entity format byte.
!
! LENGTH - A value for the length of the entity id string.
!
! ENTITY_POINTER - A character pointer to the entity id string.
!
!
! IMPLICIT INPUTS
!
! NICE buffer.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
local
OPTION;
case .TYPE from ENTITY_LO to ENTITY_HI of
set
[ENTITY_NODE]: ! Node loop test
if .USR_LEN gtr 0
or .PWD_LEN gtr 0
or .ACT_LEN gtr 0
then begin
OPTION = ((1 ^ 7) or (0 ^ 0)); ! Access control supplied
PUTB (.OPTION,REQ[RB_NICE_POINTER]); ! Write option byte
REQ[RB_NICE_LENGTH] = .REQ[RB_NICE_LENGTH] + 1; ! Bump length
NICE_ENTITY (.FORMAT, ! Build entity id
.LENGTH,
.ENTITY_POINTER);
PUTB (.USR_LEN,REQ[RB_NICE_POINTER]); ! Copy user id length
if .USR_LEN gtr 0 ! And string if any
then REQ[RB_NICE_POINTER] =
ch$move (.USR_LEN,
.USER,
.REQ[RB_NICE_POINTER]);
PUTB (.PWD_LEN,REQ[RB_NICE_POINTER]); ! Copy password length
if .PWD_LEN gtr 0 ! And string if any
then REQ[RB_NICE_POINTER] =
ch$move (.PWD_LEN,
.PWD,
.REQ[RB_NICE_POINTER]);
PUTB (.ACT_LEN,REQ[RB_NICE_POINTER]); ! Copy account length
if .ACT_LEN gtr 0 ! And string if any
then REQ[RB_NICE_POINTER] =
ch$move (.ACT_LEN,
.ACCT,
.REQ[RB_NICE_POINTER]);
REQ[RB_NICE_LENGTH] = .REQ[RB_NICE_LENGTH] + 3 +
.USR_LEN +
.PWD_LEN +
.ACT_LEN;
end
else begin
OPTION = ((0 ^ 7) or (0 ^ 0)); ! Default access control
ch$wchar_a(.OPTION,REQ[RB_NICE_POINTER]); ! Write option byte
REQ[RB_NICE_LENGTH] = .REQ[RB_NICE_LENGTH] + 1; ! Bump length
NICE_ENTITY (.FORMAT, ! Build entity id
.LENGTH,
.ENTITY_POINTER);
end;
[ENTITY_LINE, ! Data link test
ENTITY_CIRCUIT]:
begin
OPTION = ((0 ^ 7) or (.TYPE ^ 0)); ! Line loop test
ch$wchar_a(.OPTION,REQ[RB_NICE_POINTER]); ! Write option byte
REQ[RB_NICE_LENGTH] = .REQ[RB_NICE_LENGTH] + 1; ! Bump length
NICE_ENTITY (.FORMAT, ! Build entity id
.LENGTH,
.ENTITY_POINTER);
end;
[inrange, ! Invalid entity
outrange]:
;
tes
end; ! End of NICE_TEST
%routine ('NICE_ENTITY', FORMAT, LENGTH, ENTITY_POINTER) : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
ch$wchar_a (.FORMAT, REQ[RB_NICE_POINTER]); ! Write entity format byte
if .LENGTH gtr 0
then begin
REQ[RB_NICE_POINTER] = ch$move (.LENGTH,
.ENTITY_POINTER,
.REQ[RB_NICE_POINTER]);
REQ[RB_NICE_LENGTH] = .REQ[RB_NICE_LENGTH] + .LENGTH + 1;
end
else REQ[RB_NICE_LENGTH] = .REQ[RB_NICE_LENGTH] + 1;
end; ! End of NICE_ENTITY
%global_routine ('PUTBUF', PTR, BIAS, ADR, LNG) : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
! PTR -> The address of a character sequence pointer to the
! resultant text buffer.
!
! BIAS -> A BLISS value which represents a byte offset into the
! beginning of the buffer to be displayed.
!
! ADR -> The address of the buffer to be displayed
!
! LNG -> A BLISS value which represents the number of bytes
! to be displayed.
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! NONE
!
!--
begin
local
ADDRESS, !Current dump address.
BASE_ADR,
CHR_PTR, !Pointer to bytes string.
BYTES_LEFT, !Number of bytes left to process.
COUNT; !Number of bytes for this line.
literal
TEXT_BUFFER_LENGTH = 80, ! Length of text buffer in characters
TEXT_BUFFER_SIZE = ! Size in fullwords
ch$allocation (TEXT_BUFFER_LENGTH),
TEXT_BUFFER_ALLOCATION = ! Size of allocation in units
TEXT_BUFFER_SIZE * %upval,
TXT_BFR_SZ = 80; ! A Line's worth
ADDRESS = .ADR + .BIAS; ! Buffer address
BASE_ADR = .BIAS; ! Offset from start of buffer
BYTES_LEFT = .LNG; ! Length of buffer
CHR_PTR = ch$ptr(.ADDRESS,0,8); ! Pointer to bytes string.
while (COUNT = min (.BYTES_LEFT, 8)) gtr 0 do
begin
$NMU$TEXT (.PTR,
TXT_BFR_SZ,
'%(6)P %#(32L)B%2- *%#(8L)E*%/%N',
.BASE_ADR,
.COUNT,
.CHR_PTR);
CHR_PTR = ch$plus(.CHR_PTR,.COUNT); ! Bump pointer
BASE_ADR = .BASE_ADR + .COUNT;
BYTES_LEFT = .BYTES_LEFT - .COUNT;
end;
$NMU$TEXT (.PTR, ! Terminate string with null byte
TXT_BFR_SZ,
'%/');
end; ! End of PUTBUF
%routine ('ASSEMBLER', ENTITY_TYPE, PARAMETER, DATA, LENGTH) : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! Assemble data into the NICE message buffer, according to the
! specified format, and bump message counter by given length.
!
! FORMAL PARAMETERS
!
! If FORMAT is
!
! DU1,2,4 DATA - Address of location contains 1 to 4
! C1, O4 bytes of data.
!
!
! AI, HI DATA - Address of location contains pointer to
! the ASCII string for AI, and pointer to
! the field of 8-bit binary bytes for HI.
! LENGTH - Actual length of the string.
!
!
! CM2 DATA - Address of data vector, where
! +0: first 2-byte
! +1: second 2-byte
!
!
! CMN DATA - Address of location contains
! - a pointer to the node name ASCII
! string, or
! - 2 bytes of binary node address.
! LENGTH - Contains the length of the node name
! ASCII string, or 0 for node address.
!
!
! CMO DATA - Address of location contains
! - a pointer to the object name ASCII
! string, or
! - 1 byte of binary object number.
! LENGTH - Contains the length of the object name
! ASCII string, or 0 for object number.
!
!
! CME DATA - Address of data vector, where
! +0: Event class
! +1: Event mask (high order 8 bytes)
! +2: Event mask (low order 8 bytes)
! +3: Entity type
! +4: Entity id length
! +5: Entity id
!
!
! HX8 DATA - Address of location contains pointer
! to an HEX numeric string.
! LENGTH - Number of HEX digits in the string.
!
! IMPLICIT INPUTS
!
! NICE buffer.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
map
ENTITY_TYPE : FULL_ENTITY;
local
DATA_TYPE: block [1] field (DATA_TYPE_FIELDS),
NEWLEN;
DATA_TYPE = NML$DATA_TYPE (.ENTITY_TYPE, .PARAMETER);
if .DATA_TYPE[DT_CODED] eql 0
then begin
if .DATA_TYPE[DT_FTYPE] eql 0
then begin
selectone (NEWLEN = .DATA_TYPE[DT_LENGTH]) of
set
[0] : ! HI
begin
local
TEMP_STR : block [ch$allocation(32,8)],
TEMP_PTR,
TEMP;
TEMP_PTR = ch$ptr (TEMP_STR,,8);
TEMP = REMOVE_DASHES (..DATA, .LENGTH, .TEMP_PTR);
NEWLEN = (.TEMP+1)/2; ! Calculate number of bytes
PUTB (.NEWLEN,REQ[RB_NICE_POINTER]); ! Write count byte
CVATHI (.TEMP_PTR, .TEMP, REQ[RB_NICE_POINTER]);
NEWLEN = .NEWLEN + 1; ! Update length of message
end;
[1] : ! DU1
PUTB (..DATA,REQ[RB_NICE_POINTER]);
[2] : ! DU2, O2
PUTW ((.DATA),REQ[RB_NICE_POINTER]);
[4] : ! DU4, O4
begin
incr I from 0 to .NEWLEN-1
do PUTB (.(.DATA)<.I*8,8,0>,REQ[RB_NICE_POINTER]);
end;
[8] : ! HX8
begin
local
TEMP_STR : block [ch$allocation(32,8)],
TEMP_PTR,
TEMP;
TEMP_PTR = ch$ptr (TEMP_STR,,8);
TEMP = REMOVE_DASHES (..DATA, .LENGTH, .TEMP_PTR);
CVATH (.TEMP_PTR, .TEMP, REQ[RB_NICE_POINTER]);
REQ[RB_NICE_POINTER] =
ch$fill (0,
.NEWLEN - min((.TEMP+1)/2,.NEWLEN),
.REQ[RB_NICE_POINTER]);
end;
[otherwise] :
$INTERNAL_ERROR$ ('Unable to assemble parameter code');
tes;
end
else begin ! AI
if .LENGTH gtr 0
then begin ! Regular ASCII parameter
PUTB (.LENGTH,REQ[RB_NICE_POINTER]);
REQ[RB_NICE_POINTER] = ch$move (.LENGTH,
..DATA,
.REQ[RB_NICE_POINTER]);
NEWLEN = .LENGTH + 1;
end
else begin
if NML$INFORMATION (.ENTITY_TYPE, .PARAMETER, QUALIFIER_)
then begin ! This must be the KNOWN Qualifier.
PUTB (KNOWN_, REQ[RB_NICE_POINTER]);
NEWLEN = 1;
end
else return;
end;
end;
end
else if .DATA_TYPE[DT_FIELDS] eql 0
then begin
selectone (NEWLEN = .DATA_TYPE[DT_NUMBER]) of
set
[1]: ! C1
PUTB (..DATA,REQ[RB_NICE_POINTER]);
[otherwise]:
$INTERNAL_ERROR$ ('Unable to assemble parameter code');
tes;
end
else NEWLEN = 0;
if .NEWLEN neq 0
then begin
REQ[RB_NICE_LENGTH] = .REQ[RB_NICE_LENGTH] + .NEWLEN;
return
end;
selectone .DATA_TYPE[DT_NUMBER] of
set
[CMN, ! Coded node field
CMO] : ! Coded object field
begin
if .LENGTH gtr 0
then begin ! Write node name or object name
PUTB (.LENGTH,REQ[RB_NICE_POINTER]);
REQ[RB_NICE_POINTER] = ch$move (.LENGTH,
..DATA,
.REQ[RB_NICE_POINTER]);
NEWLEN = .LENGTH + 1; ! Bump length
end
else begin
if NML$INFORMATION (.ENTITY_TYPE, .PARAMETER, EVENTS_)
and (.DATA_TYPE[DT_NUMBER] eql CMN)
and (..DATA eql -1)
then begin ! KNOWN SINKS parameter
PUTB (-1,REQ[RB_NICE_POINTER]);
NEWLEN = 1;
end
else begin ! Regular NODE number
PUTB (%O'0',REQ[RB_NICE_POINTER]);
NEWLEN = (if .DATA_TYPE[DT_NUMBER] eql CMN
then begin ! Write 2 bytes of node address
PUTW ((.DATA),REQ[RB_NICE_POINTER]);
3 ! Bump length
end
else begin ! Write 1 byte of object number
PUTB (..DATA,REQ[RB_NICE_POINTER]);
2 ! Bump length
end);
end;
end;
end;
[CM2] : ! Coded 2 fields
begin
if .(.DATA+1) eql 0 ! Set null range end to same as begin
then (.DATA+1) = ..DATA;
PUTW ((.DATA),REQ[RB_NICE_POINTER]);
PUTW ((.DATA+1),REQ[RB_NICE_POINTER]);
NEWLEN = 4;
end;
[CME] : ! Coded event fields
begin
local LEN;
bind
CLASS = (.DATA+0),
EMASK = (.DATA+2),
ETYPE = (.DATA+3),
IDLEN = (.DATA+4),
IDVAL = (.DATA+5);
PUTB (.ETYPE,REQ[RB_NICE_POINTER]); ! Write entity type
NEWLEN = 1;
if .ETYPE gtr -1 ! Write entity type and id
then begin
if (LEN = .IDLEN) gtr 0
then begin ! NODE, LINE, CIRCUIT and MODULE id
LEN = min(.LEN,(if .ETYPE eql $KNNOD then 6 else 16));
PUTB (.LEN,REQ[RB_NICE_POINTER]);
REQ[RB_NICE_POINTER] = ch$move (.LEN,
.IDVAL,
.REQ[RB_NICE_POINTER]);
NEWLEN = .NEWLEN + .LEN + 1;
end
else begin ! NODE number
PUTB (%O'0',REQ[RB_NICE_POINTER]);
PUTW (IDVAL,REQ[RB_NICE_POINTER]);
NEWLEN = .NEWLEN + 3;
end;
end;
PUTW (CLASS,REQ[RB_NICE_POINTER]); ! Write event class
NEWLEN = .NEWLEN + 2;
if (.EMASK neq 0) or (.(EMASK-1) neq 0)
then begin ! Write event mask
local MSKCNT, SCANNING;
SCANNING = $TRUE;
MSKCNT = 8; ! Assume there are 8 bytes to write
decr J from 1 to 0 ! Verify that and remove hi order
do begin ! zero bytes
decr I from 24 to 0 by 8
do begin
if .(EMASK-.J)<.I,8,0> eql 0
then MSKCNT = .MSKCNT - 1
else begin
SCANNING = $FALSE;
exitloop;
end;
end;
if not .SCANNING
then exitloop;
end;
if .MSKCNT gtr 0
then begin
PUTB (.MSKCNT,REQ[RB_NICE_POINTER]); ! Write count byte
NEWLEN = .NEWLEN + .MSKCNT + 1; ! Update length
incr J from 0 to 1
do incr I from 0 to 24 by 8
do begin ! Write mask, lo order bytes first
if .MSKCNT gtr 0
then PUTB (.(EMASK-.J)<.I,8,0>,REQ[RB_NICE_POINTER])
else exitloop;
MSKCNT = .MSKCNT - 1;
end;
end;
end;
end;
[otherwise] :
$INTERNAL_ERROR$ ('Unable to assemble parameter code');
tes;
REQ[RB_NICE_LENGTH] = .REQ[RB_NICE_LENGTH] + .NEWLEN;
end; ! End of ASSEMBLER
%routine ('NICE_PARM', LENGTH, DATA, CLEAR_PURGE, PARAMETER, ENTITY_TYPE) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Builds a single parameter field in a NICE message.
! A single parameter is written into the NICE buffer and current
! NICE message length is updated accordingly. The NICE request message
! pointer is updated to point to the next available in the buffer.
!
! FORMAL PARAMETERS
!
! LENGTH - An optional parameter which provides the length in
! bytes of parameter data which is of variable length.
!
! DATA - The vector contains addresses of the data, to be
! interpreted according to the entity type.
!
! CLEAR_PURGE - A flag to indicate whether data is to be written along
! with the DATA ID field, i.e., whether we are doing a
! SET/DEFINE or a CLEAR/PURGE.
!
! PARAMETER - A value to be placed in the parameter type number field
! (bits 0 to 11) in the data id field of a parameter.
!
! ENTITY_TYPE - The entity type with which the parameter is associated.
!
! IMPLICIT INPUTS
!
! NICE buffer.
!
! ROUTINE VALUE:
!
! $TRUE, If the parameter number is valid and the data has been
! written into the NICE request message buffer;
! $FALSE, otherwise.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
map
ENTITY_TYPE : FULL_ENTITY;
local
NUMBER;
if .PARAMETER eql P$ALL ! ALL Parameter ?
then return $TRUE; ! Requires no processing
NUMBER = .PARAMETER and %O'7777'; ! Mask data id to be exactly 12 bits
PUTW (NUMBER, REQ[RB_NICE_POINTER]);
REQ[RB_NICE_LENGTH] = .REQ[RB_NICE_LENGTH] + 2; ! Bump length
! If CLEAR_PURGE flag is set, but DATA vector contain non-zero data,
! and the entity is MODULE, then it may be qualifier identification
! string, so write it; otherwise, there should not be any data following
! parameter numbers when the CLEAR_PURGE flag is set.
if .CLEAR_PURGE ! Need to write the data ?
and not (NML$INFORMATION (.ENTITY_TYPE, .PARAMETER, QUALIFIER_) or
NML$INFORMATION (.ENTITY_TYPE, .PARAMETER, EVENTS_))
then return $TRUE; ! No, all done
if NML$UPPER_CASE (.ENTITY_TYPE, .PARAMETER)
then CVLTU (..DATA, .LENGTH); ! Convert text to upper case
ASSEMBLER (.ENTITY_TYPE, ! Entity type
.PARAMETER, ! Parameter Number
.DATA, ! Address of the data vector
.LENGTH); ! Actual length of data item
return $TRUE;
end; ! End of NICE_PARM
end ! End of Module NCPCEX
eludom
! Local Modes:
! Mode:BLISS
! Auto Save Mode:0
! Comment Column:40
! Comment Rounding:+1
! End: