Trailing-Edge
-
PDP-10 Archives
-
BB-FB49A-RM
-
sources/sntdef.r36
There are no other files named sntdef.r36 in the archive.
%title 'SNT Common Definitions Version 1.05'
! Copyright (c) 1984, 1985 by
! DIGITAL EQUIPMENT CORPORATION, Maynard, Massachusetts
!
! This software is furnished under a license and may be used and copied
! only in accordance with the terms of such license and with the
! inclusion of the above copyright notice. This software or any other
! copies thereof may not be provided or otherwise made available to any
! other person. No title to and ownership of the software is hereby
! transferred.
!
! The information in this software is subject to change without notice
! and should not be construed as a commitment by Digital Equipment
! Corporation.
!
! Digital assumes no responsibility for the use or reliability of its
! software on equipment which is not supplied by Digital.
!
! MODIFIED BY
! Dennis Brannon, 11-Oct-84 : VERSION 1.00
!
! 1.01 D. Brannon, 18-Oct-84
! Changed copyright statement to display clearer.
!
! 1.02 D. Brannon, 24-Oct-84
! Removed unused fields from SNTBLOCK and added comments to others.
!
! 1.03 D. Brannon, 24-Oct-84
! Added USPTRN definition for USP$TRANSLATE_SNAGAT routine
!
! 1.04 D. Brannon, 1-Feb-85
! Modified $TRACE_MSG macro to display the message in both octal and hex.
!
! 1.05 D. Brannon, 9-Feb-85
! Added macro definition to change ANA$ANALYZE into 6 character name
! ANALYZ.
!--
!
! $CRLF Create a ascii CRLF
macro $CRLF = %string (%char(10),%char(13)) %;
macro COPYRIGHT_STATEMENT =
bind ______ = ch$ptr ( uplit (%asciz %string (
$CRLF,
$CRLF,
' COPYRIGHT (C) 1984, 1985 BY ',$CRLF,
' Digital Equipment Corporation',$CRLF,
' ALL Rights Reserved',$CRLF,
$CRLF))) %;
library 'SNAXPT'; ! Our own copy XPORT
$show (fields, noinfo)
require 'ARGBLK'; ! Argument Block Definitions
%sbttl 'Command Syntax Literals'
require 'SNTSYN';
require 'SNTSYN.UND'; ! Undeclares to remove TXTLIB defs
%sbttl 'Common Literal Definitions'
literal
$VERSION_NUMBER = 1,
$MINOR_NUMBER = 0,
$EDIT_NUMBER = 34; ! This must be changed for each edit
literal ! Library version number
EV$VER = %O'001', ! Major
EV$ECO = %O'000', ! ECO
EV$UEC = %O'000'; ! Customer ECO
macro EDIT_VERSION =
%name ('E.VERS'): initial (EV$VER ^ 28 + EV$ECO ^ 20 + EV$UEC ^ 12) %;
macro ! Gateway Access version text strings
XV_VER = '001' %, ! Major
XV_ECO = '000' %, ! ECO
XV_UEC = '000' %; ! Customer ECO
literal ! Gateway Access version numeric value
XV$VER = %O'001', ! Major
XV$ECO = %O'000', ! ECO
XV$UEC = %O'000'; ! Customer ECO
macro PROTOCOL_VERSION =
%name ('P.VERS'): initial (XV$VER ^ 28 + XV$ECO ^ 20 + XV$UEC ^ 12) %;
literal ! SNT Protocol version number
STVER = %O'001', ! Major
STECO = %O'000', ! ECO
STUEC = %O'000'; ! Customer ECO
literal ! Boolean literals
$TRUE = (1 eql 1),
$FALSE = (1 eql 0);
literal ! Text output literals
TEXT_BUFFER_LEN = 1024;
literal
$MAXIMUM_SUPPORTED_LINKS = 20, ! Maximum supported DECnet Logical Links
$MAXIMUM_SUPPORTED_PORTS = 16, ! Maximum supported AI ports
$KNOWN_PORTS = -1,
$SINGLE_PORT = 0,
$ACTIVE_PORTS = 1;
literal
$PACKET_SIZE = 128,
$CLEAR_DATA_SIZE = 128,
$RESET_DATA_SIZE = 128;
literal
$SWITCHED_CIRCUIT = 0,
$PERMANENT_CIRCUIT = 1;
literal
$NORMAL = 0,
$QUALIFIED = 1;
literal
$INTERRUPT = -1,
$ECHOED_DATA_FAILED = -2,
$ECHOED_INTERRUPT_FAILED = -3,
$ECHOED_INTERRUPT_WAITING = -4;
%sbttl 'Lexical Character Literals'
macro $CONTROL_CHARACTER_LIST$ =
NUL, SOH, STX, ETX, EOT, ENQ, ACK, BEL, BS, HT, LF, VT, FF, CR, SO, SI,
DLE, DC1, DC2, DC3, DC4, NAK, SYN, ETB, CAN, EM, SUB, ESC, FS, GS, RS,
US, DEL
%;
macro $LEXICAL_CHARACTER_LIST$ =
BLANK, EXCLAMATION, DOUBLE_QUOTE, POUND, DOLLAR, PERCENT, AMPERSAND,
QUOTE, LEFT_PARENTHESIS, RIGHT_PARENTHESIS, ASTERISK, PLUS, COMMA, MINUS,
PERIOD, SLASH, ZERO, ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE,
COLON, SEMICOLON, LEFT_ANGLE, EQUAL, RIGHT_ANGLE, QUESTION, ATSIGN,
UPPER_A, UPPER_B, UPPER_C, UPPER_D, UPPER_E, UPPER_F, UPPER_G, UPPER_H,
UPPER_I, UPPER_J, UPPER_K, UPPER_L, UPPER_M, UPPER_N, UPPER_O, UPPER_P,
UPPER_Q, UPPER_R, UPPER_S, UPPER_T, UPPER_U, UPPER_V, UPPER_W, UPPER_X,
UPPER_Y, UPPER_Z, LEFT_BRACKET, BACK_SLASH, RIGH_BRACKET, UPARROW,
UNDERLINE, GRAVE, LOWER_A, LOWER_B, LOWER_C, LOWER_D, LOWER_E, LOWER_F,
LOWER_G, LOWER_H, LOWER_I, LOWER_J, LOWER_K, LOWER_L, LOWER_M, LOWER_N,
LOWER_O, LOWER_P, LOWER_Q, LOWER_R, LOWER_S, LOWER_T, LOWER_U, LOWER_V,
LOWER_W, LOWER_X, LOWER_Y, LOWER_Z, LEFT_CURL, VERTICAL_BAR, RIGHT_CURL,
TILDE
%;
macro $CONTROL_CHARACTERS$ [CHAR] =
%if (%count leq %O'32') and (%count gtr 0)
%then %name('CTRL_',%char(%count+%O'100')) = %count,
%print (' CTRL_',%char(%count+%O'100'),' = ',%count)
%fi
%if %count leq %O'37'
%then %name('$',%string(CHAR)) = %count
%print (' $',%string(CHAR),' = ',%count)
%else %name('$',%string(CHAR)) = %O'177'
%print (' $',%string(CHAR),' = ',%O'177')
%fi
%;
compiletime
%LEXICAL = 0;
macro $LEXICAL_CHARACTERS$ [CHAR] =
%assign (%LEXICAL, %O'40' + %count)
%name('$',%string(CHAR)) = %number(%LEXICAL)
%print (' $',%string(CHAR),' = ',%number(%LEXICAL))
%;
literal
$CONTROL_CHARACTERS$ ($CONTROL_CHARACTER_LIST$);
literal
$LEXICAL_CHARACTERS$ ($LEXICAL_CHARACTER_LIST$);
%sbttl 'BLT Macro'
macro XERO (XBLOCK, XLEN) =
begin
register AC;
builtin MACHOP;
literal BLT = %o'251';
XBLOCK = 0;
AC<18,18> = XBLOCK;
AC<0,18> = XBLOCK + 1;
MACHOP (BLT, AC, XBLOCK + XLEN-1);
end%;
%sbttl 'Lexical Macros'
! GETW Returns 2 8-bit bytes in
! pointer Address of pointer to the source string
macro GETW (POINTER) =
begin
local $$GETW_;
$$GETW_<0,8,0> = ch$rchar_a (POINTER);
$$GETW_<8,8,0> = ch$rchar_a (POINTER);
.$$GETW_<0,16,0>
end %;
! CH$BYTE Create characters as 8-bit bytes and fill each word
! from left to right.
! char1 Characters to be converted.
! char2
! char3
! char4
macro CH$BYTE [CHAR1, CHAR2, CHAR3, CHAR4] =
((%C %string (CHAR1) ^ (%bpval-8))
%if not %null (CHAR2)
%then or (%C %string (CHAR2) ^ (%bpval-16))
%if not %null (CHAR3)
%then or (%C %string (CHAR3) ^ (%bpval-24))
%if not %null (CHAR4)
%then or (%C %string (CHAR4) ^ (%bpval-32))
%fi
%fi
%fi) %;
! Structure $BPBLOCK - Tops-10/20 Byte Pointer style byte block
! O = byte offset from start of block
! P = position within byte
! S = size of field
! E = sign
! N = number of words
! Four 8 bit bytes in a 36 bit word stored as
! [byte 0][byte 1][byte 2][byte 3][4 extra bits]
! [byte 4][byte 5][byte 6][byte 7][4 extra bits]...etc.
STRUCTURE
$BPBLOCK [O, P, S, E; N] =
[N]
($BPBLOCK+(O/4))<(28-((O-(O/4*4))*8)+P),S,E>;
!Structure $BBLOCK - VMS style byte block
! O = byte offset from start of block
! P = position within byte
! S = size of field
! E = sign
! N = number of words
! Four 8 bit bytes in a 36 bit word stored as
! [4 extra bits][byte 3][byte 2][byte 1][byte 0]
! [4 extra bits][byte 7][byte 6][byte 5][byte 4]...etc.
STRUCTURE
$BBLOCK [O, P, S, E; N] =
[N]
($BBLOCK+(O/4))<((O-(O/4*4))*8+P),S,E>;
! CH$ASCI8 Create 8-bit byte string.
! string Text string.
macro CH$ASCI8 [] =
ch$ptr (uplit (CH$BYTE (%explode (%string (%remaining, %char (0))))),,8) %;
! CH$ASCIC Create a 7-bit byte counted string.
! string Text string.
macro CH$ASCIC [] =
ch$ptr (uplit (%string (%char (%charcount (%remaining)), %remaining))) %;
! CH$ASCIZ Create 7-bit byte string with trailing null
! string Text string.
macro CH$ASCIZ [] =
ch$ptr (uplit (%asciz %string (%remaining, %char (0)))) %;
! CH$ASCII Create 7-bit byte string.
! string Text string.
macro CH$ASCII [] =
ch$ptr (uplit (%ascii %string (%remaining))) %;
! CH$SEQUENCE Create string buffer vector.
! length Length of the buffer in bytes.
! size Size of the byte unit (optional, default is 7)
macro CH$SEQUENCE (LENGTH, SIZE) =
vector [ch$allocation (LENGTH %if not %null (SIZE) %then , SIZE %fi)] %;
! CH$LEN Get the length of an ASCIZ string.
! pointer Pointer to the string.
macro CH$LEN (POINTER, LENGTH) =
ch$diff (ch$find_ch (%if %null (LENGTH)
%then 2048
%else LENGTH %fi,
POINTER,
0),
POINTER) %;
! CH$MOVZSTRING Copy string to buffer as ASCIZ string
! pointer Address of the pointer to the string
macro CH$MOVZSTRING (POINTER_ADDRESS) [] =
%if %isstring (%remaining)
%then POINTER_ADDRESS = ch$move (%charcount (%string (%remaining)) + 1,
CH$ASCIZ (%remaining),
.POINTER_ADDRESS)
%else %if %length gtr 2
%then %error ('Illegal parameter count for CH$MOVSTRING')
%else begin
local LEN;
LEN = CH$LEN (%remaining) + 1;
POINTER_ADDRESS = ch$move (.LEN, %remaining, .POINTER_ADDRESS);
end
%fi
%fi %;
! CH$MOVCSTRING Copy string to buffer as counted string
! pointer Address of the pointer to the string
macro CH$MOVCSTRING (POINTER) [ ] =
%if %isstring (%remaining)
%then POINTER = ch$move (%charcount (%string (%remaining)) + 1,
CH$ASCIC (%remaining),
.POINTER)
%else %if %length gtr 2
%then %error ('Illegal parameter count for CH$MOVCSTRING')
%else begin
local LEN;
LEN = ch$rchar (%remaining) + 1;
POINTER = ch$move (.LEN, %remaining, .POINTER);
end
%fi
%fi %;
! CH$MOVESTRING Copy ASCIZ string to buffer as ASCII string
! pointer Address of the pointer to the string
macro CH$MOVESTRING (POINTER_ADDRESS) [] =
%if %isstring (%remaining)
%then POINTER_ADDRESS = ch$move (%charcount (%string (%remaining)),
CH$ASCIZ (%remaining),
.POINTER_ADDRESS)
%else %if %length gtr 2
%then %error ('Illegal parameter count for CH$MOVESTRING')
%else begin
local LEN;
LEN = CH$LEN (%remaining);
POINTER_ADDRESS = ch$move (.LEN, %remaining, .POINTER_ADDRESS);
end
%fi
%fi %;
macro CH$MOVSTRING (POINTER_ADDRESS) [] =
%if %isstring (%remaining)
%then POINTER_ADDRESS = ch$move (%charcount (%string (%remaining)),
CH$ASCIZ (%remaining),
.POINTER_ADDRESS)
%else %if %length gtr 2
%then %error ('Illegal parameter count for CH$MOVSTRING')
%else begin
local LEN;
LEN = CH$LEN (%remaining);
POINTER_ADDRESS = ch$move (.LEN, %remaining, .POINTER_ADDRESS);
end
%fi
%fi %;
! CH$RWORD Read a 16-bit value from the buffer (in PDP-11 order)
! pointer Pointer to the source string
macro CH$RWORD (POINTER) =
begin
local VAL;
VAL = 0;
VAL<0,8> = ch$rchar (POINTER);
VAL<8,8> = ch$rchar (ch$plus (POINTER,1));
.VAL
end %;
! CH$RWORD_A Read a 16-bit value from the string (in PDP-11 order)
! and advance the source pointer
! pointer Address of the pointer to the string
macro CH$RWORD_A (POINTER) =
begin
local VAL;
VAL = 0;
VAL<0,8> = ch$rchar_a (POINTER);
VAL<8,8> = ch$rchar_a (POINTER);
.VAL
end %;
! CH$WWORD Write a 16-bit value as two bytes (in the PDP-11 order)
! value Value to be written
! pointer Pointer to the string
macro CH$WWORD (VALUE, POINTER) =
begin
local VAL;
VAL = VALUE;
ch$wchar (.VAL<0,8>, POINTER);
ch$wchar (.VAL<8,8>, ch$plus (POINTER,1));
end %;
! CH$WWORD_A Write a 16-bit value as two bytes (in the PDP-11 order)
! and advance the pointer
! value Value to be written
! pointer Address of pointer to the string
macro CH$WWORD_A (VALUE, POINTER) =
begin
local VAL;
VAL = VALUE;
ch$wchar_a (.VAL<0,8>, POINTER);
ch$wchar_a (.VAL<8,8>, POINTER);
end %;
! CH$RLWORD_A Read a 32-bit value as four bytes (in the PDP-11 order)
! and advance the pointer
! value Value to be written
! pointer Address of pointer to the string
macro CH$RLWORD (POINTER) =
begin
local VAL;
VAL = 0;
VAL<0,8> = ch$rchar (POINTER);
VAL<8,8> = ch$rchar (ch$plus (POINTER,1));
VAL<16,8> = ch$rchar (ch$plus (POINTER,2));
VAL<24,8> = ch$rchar (ch$plus (POINTER,3));
.VAL
end %;
! CH$RLWORD_A Read a 32-bit value as four bytes (in the PDP-11 order)
! and advance the pointer
! value Value to be written
! pointer Address of pointer to the string
macro CH$RLWORD_A (POINTER_ADDRESS) =
begin
local VAL;
VAL = 0;
VAL<0,8> = ch$rchar_a (POINTER_ADDRESS);
VAL<8,8> = ch$rchar_a (POINTER_ADDRESS);
VAL<16,8> = ch$rchar_a (POINTER_ADDRESS);
VAL<24,8> = ch$rchar_a (POINTER_ADDRESS);
.VAL
end %;
! CH$WLWORD_A Write a 32-bit value as four bytes (in the PDP-11 order)
! and advance the pointer
! value Value to be written
! pointer Address of pointer to the string
macro CH$WLWORD (VALUE, POINTER) =
begin
local VAL;
VAL = VALUE;
ch$wchar (.VAL<0,8>, POINTER);
ch$wchar (.VAL<8,8>, ch$plus (POINTER,1));
ch$wchar (.VAL<16,8>, ch$plus (POINTER,2));
ch$wchar (.VAL<24,8>, ch$plus (POINTER,3));
end %;
! CH$WLWORD_A Write a 32-bit value as four bytes (in the PDP-11 order)
! and advance the pointer
! value Value to be written
! pointer Address of pointer to the string
macro CH$WLWORD_A (VALUE, POINTER_ADDRESS) =
begin
local VAL;
VAL = VALUE;
ch$wchar_a (.VAL<0,8>, POINTER_ADDRESS);
ch$wchar_a (.VAL<8,8>, POINTER_ADDRESS);
ch$wchar_a (.VAL<16,8>, POINTER_ADDRESS);
ch$wchar_a (.VAL<24,8>, POINTER_ADDRESS);
end %;
! $$ Deposit a value to field.
! value Value to be deposited.
! mask Mask specifying the field.
macro $$ (VALUE, MASK) =
((VALUE) ^ (%nbitsu (MASK and -MASK) -1)) %;
! $ Create a field definition from a mask.
! mask Mask specifying the field.
macro $ (MASK) =
%nbitsu (MASK and -MASK) -1,
%nbitsu (MASK ^ -(%nbitsu (MASK and -MASK) -1) and (1 ^ (36 - (%nbitsu (MASK and -MASK) -1))) -1) %;
%sbttl 'General Supporting Macros'
macro ! GLXLIB routines
GLX$K_SOUT = K_SOUT %,
GLX$F_OOPN = F_OOPN %,
GLX$F_OBUF = F_OBUF %,
GLX$F_IOPN = F_IOPN %,
GLX$F_IBUF = F_IBUF %;
macro LIST_COUNT (LIST) =
%length
%print (%length) %;
%sbttl 'Supporting Macros'
literal
PAT_BUFFER_LEN = 35, ! Maximum pattern length
MSG_BUFFER_LEN = 511; ! Maximum message length
macro $TRACE_MSG (TAG, MSG_LEN, MSG) =
begin
local PAT_BUFFER: CH$SEQUENCE (PAT_BUFFER_LEN, 7),
MSG_BUFFER: CH$SEQUENCE (MSG_BUFFER_LEN, 7),
LENGTH,
POINTER;
external
CONTROL: GLOBAL_CONTROL_BLOCK;
external routine
GLX$K_SOUT: GALAXY,
TXTWRT;
if .CONTROL[GCB_DEBUG_CALLS]
then begin
POINTER = ch$ptr (PAT_BUFFER);
LENGTH = TXT_WRITE (POINTER,
PAT_BUFFER_LEN,
%string ('%/', TAG, '(Oct): ','%%%DB%/'),
MSG_LEN);
POINTER = ch$ptr (MSG_BUFFER);
LENGTH = TXT_WRITE (POINTER,
MSG_BUFFER_LEN,
ch$ptr (PAT_BUFFER),
ch$ptr (MSG,,8)) + LENGTH;
JSYS_SOUT (.ST[ST_OUTPUT_JFN], CH$PTR(MSG_BUFFER), .LENGTH);
! GLX$K_SOUT (MSG_BUFFER);
POINTER = ch$ptr (PAT_BUFFER);
LENGTH = TXT_WRITE (POINTER,
PAT_BUFFER_LEN,
%string ('%/',TAG,'(Hex): ','%%%DK%/%/'),
MSG_LEN);
POINTER = ch$ptr (MSG_BUFFER);
LENGTH = TXT_WRITE (POINTER,
MSG_BUFFER_LEN,
ch$ptr (PAT_BUFFER),
ch$ptr (MSG,,8)) + LENGTH;
JSYS_SOUT (.ST[ST_OUTPUT_JFN], CH$PTR(MSG_BUFFER), .LENGTH);
! GLX$K_SOUT (MSG_BUFFER);
end;
end %;
macro $HEXTRACE_MSG (TAG, MSG_LEN, MSG) =
begin
external
CONTROL: GLOBAL_CONTROL_BLOCK;
if .CONTROL[GCB_DEBUG_CALLS]
then begin
local PAT_BUFFER: CH$SEQUENCE (PAT_BUFFER_LEN, 7),
MSG_BUFFER: CH$SEQUENCE (MSG_BUFFER_LEN, 7),
POINTER;
external routine
GLX$K_SOUT: GALAXY,
TXTWRT;
POINTER = ch$ptr (PAT_BUFFER);
TXT_WRITE (POINTER,
PAT_BUFFER_LEN,
%string (%CHAR($CR,$LF), TAG, '%%%DK%/'),
MSG_LEN);
POINTER = ch$ptr (MSG_BUFFER);
TXT_WRITE (POINTER,
MSG_BUFFER_LEN,
ch$ptr (PAT_BUFFER),
ch$ptr (MSG,,8));
GLX$K_SOUT (MSG_BUFFER);
end;
end %;
macro $INITIALIZE_BLOCK (BLOCK, BLOCK_SIZE) =
ch$fill (0, BLOCK_SIZE, ch$ptr (BLOCK,,36)) %;
%sbttl 'Error Message Block Macros'
!
! Macro to build an error message block
!
macro $RETURN_ERROR (code) =
begin
.ST[ST_ERROR_BLOCK] + .(.ST[ST_ERRPTR_ADDRESS]) = code;
.ST[ST_ERRPTR_ADDRESS] = .(.ST[ST_ERRPTR_ADDRESS]) + 1;
return $FALSE;
end %;
%sbttl 'X.25 Port Data Block Field Definitions'
$field PORT_CONTROL_BLOCK_FIELDS =
set
PCB_BLOCK_FIELD = [$sub_block()],
PCB_JFN = [$byte], ! Gateway logical link JFN
PCB_STATE = [$byte], ! Port state
PCB_FLAGS = [$byte], ! Control flags
PCB_RESET_SEEN = [$tiny_integer], ! Reset seen counter
PCB_ERROR = [$bytes(2)], ! Port error
PCB_PACKET_SIZE = [$bytes(2)], ! Current packet size
PCB_DATA_BASE = [$address], ! Current user data base
PCB_INPUT_BUFFER = [$address], ! Address of input buffer data
PCB_OUTPUT_BUFFER = [$address], ! Address of output buffer data
$overlay (PCB_FLAGS)
PCB_XMT_INTERRUPT = [$bit], ! Unconfirmed transmitted interrupt
PCB_RCV_INTERRUPT = [$bit], ! Unconfirmed received interrupt
PCB_DATA = [$bit] ! Data available flag
$continue
tes;
literal
PORT_CONTROL_BLOCK_SIZE = $field_set_size;
macro PORT_CONTROL_BLOCK =
block [PORT_CONTROL_BLOCK_SIZE] field (PORT_CONTROL_BLOCK_FIELDS) %;
macro PORT_CONTROL_BLOCKS =
blockvector [MAXIMUM_SUPPORTED_PORTS, PORT_CONTROL_BLOCK_SIZE]
field (PORT_CONTROL_BLOCK_FIELDS) %;
macro INITIAL_STACK (SIZE) [] =
%if %count lss SIZE
%then %if %count gtr 0 %then , %fi
%count
INITIAL_STACK (SIZE)
%else %exitmacro %fi %;
macro STACK (SIZE) =
vector [SIZE] %;
%sbttl 'SNT Data Block Field Definitions'
$field SNTBLOCK_FIELDS =
set
ST_GATEWAY = [$pointer], ! Ptr to the asciz gateway node name
ST_USER = [$pointer], ! Ptr to the asciz user-id string
ST_PASSWORD = [$pointer], ! Ptr to the asciz password string
ST_CIRCUIT_ID = [$pointer], ! Ptr to the asciz Circuit_id
ST_OUTPUT_FILE = [$pointer], ! Ptr to the asciz output file name
ST_TRACE_FILE = [$pointer], ! Ptr to the asciz trace file name
ST_ANALYZE_FILE = [$pointer], ! Ptr to the asciz analyze file name
ST_HEADER = [$fullword], ! Address of the Trace Header record
ST_HLEN = [$fullword], ! Length of the Trace Header record
ST_JFN = [$fullword], ! JFN for Gateway logical link
ST_ANALYZE_JFN = [$fullword], ! JFN for Analyzed filename (input)
ST_TRACE_JFN = [$fullword], ! JFN for Trace filename (binary)
ST_OUTPUT_JFN = [$fullword], ! JFN for Output filename (ascii)
ST_HELP_JFN = [$fullword], ! JFN for Help filename (input)
ST_SWITCH = [$fullword], ! Command modifiers
ST_BUFFERS = [$fullword], ! Server buffering level
ST_TYPE = [$fullword], ! Type of trace
ST_FILES = [$fullword], ! This file number
ST_FILENUM = [$fullword], ! Number of this file
ST_FILESIZE = [$fullword], ! Maximum file size
ST_ENTRIES = [$fullword], ! Maximum entries
ST_SIZE = [$fullword], ! Max trace data size
ST_SESSION = [$fullword], ! Session to trace
ST_MSGLEN = [$fullword], ! Max message length
ST_SEGLEN = [$fullword], ! Segment length
ST_CHARACTER_SET = [$fullword], ! Address of the translation table
ST_MAXFILES = [$fullword], ! Maximum number of files
ST_TIMBUF = [$pointer], ! Pointer to Record time
ST_ALQ = [$fullword], ! Disk Allocation quota
ST_STATE = [$fullword], ! Trace state
ST_CMD = [$fullword], ! Command
ST_STATUS = [$fullword], ! Trace status
ST_STATUS2 = [$fullword], ! Secondary trace status
ST_RSP_CODE = [$fullword], ! Response message type
ST_RSP_FLAGS = [$fullword], ! Response message flags
ST_FLAGS = [$fullword], ! Status flags
ST_WORK_AREA = [$fullword], ! Address of work area
ST_INPUT_BUFFER = [$fullword], ! Address of input buffer data
ST_OUTPUT_BUFFER = [$fullword], ! Address of output buffer data
ST_INPUT_BUFFER_LEN = [$fullword], ! Count of data in buffer
ST_OUTPUT_BUFFER_LEN = [$fullword], ! Count of data in buffer
ST_ARGPTR_ADDRESS = [$fullword], ! Address of message block arg ptr
ST_MESSAGE_BLOCK = [$fullword], ! Message block
ST_ERRPTR_ADDRESS = [$fullword], ! Address of error block arg ptr
ST_ERROR_BLOCK = [$fullword], ! Address of error block
ST_DATA_BLOCK = [$fullword], ! Address of data to be returned
ST_DATA_SIZE = [$fullword], ! Size of returned data
ST_ERROR_CODE = [$fullword], ! Error code
$overlay (ST_CMD)
CMD_ANALYZE = [$bit], ! Analyze command
CMD_DDT = [$bit], ! DDT command
CMD_DEBUG = [$bit], ! Debug command
CMD_EXIT = [$bit], ! Exit command
CMD_HELP = [$bit], ! Help command
CMD_PUSH = [$bit], ! Push command
CMD_TAKE = [$bit], ! Take command
CMD_TRACE = [$bit], ! Trace command
$continue
$overlay (ST_FLAGS)
RSP_STR = [$bit], ! Response was STR
RSP_DAT = [$bit], ! Response was DAT
RSP_UNK = [$bit], ! Response was unknown
MSG_PENDING = [$bit], ! Request outstanding
ABORT_TRACE = [$bit], ! Abort the tracing
STOP_TRACE = [$bit], ! Stop tracing
$continue
$overlay (ST_SWITCH)
SW_ANALYZE = [$bit], ! /Analyze
SW_BUFFERS = [$bit], ! /Buffers:n
SW_CHARACTER_SET = [$bit], ! /Character_set:input filespec
SW_CIRCUIT = [$bit], ! /Circuit
SW_ENTRIES = [$bit], ! /Entries:n
SW_OUTPUT = [$bit], ! /Output:filespec
SW_PASSWORD = [$bit], ! /Password:gateway password
SW_PU = [$bit], ! /PU
SW_SESSION = [$bit], ! /Session:n
SW_SIZE = [$bit], ! /Size:n
SW_USER = [$bit], ! /User:gateway username
SW_VERSION_LIMIT = [$bit], ! /Version_limit:n
SW_WIDE = [$bit] ! /Wide
$continue
tes;
literal
SNTBLOCK_SIZE = $field_set_size;
macro SNTBLOCK =
block [SNTBLOCK_SIZE] field (SNTBLOCK_FIELDS) %;
%sbttl 'Bliss Signaling definitions'
$field CONDIT_FIELDS =
set
STS$V_SEVERITY = [0,0,3,0], ! Severity field
STS$V_SUCCESS = [0,0,1,0], ! Success field (subfield of severity)
STS$V_COND_ID = [0,3,29,0], ! Identity field
STS$V_MSG_NO = [0,3,15,0], ! Message number field
STS$V_FAC_SP = [0,17,1,0], ! Facility specific field
STS$V_CODE = [0,3,14,0], ! Code for condition only
STS$V_FAC_NO = [0,18,14,0], ! Facility code
STS$V_CUST_DEF = [0,31,1,0] ! Customer definition flag
tes;
macro CONDITION_VALUE = BLOCK[1] FIELD(CONDIT_FIELDS) %;
%sbttl 'SNT Work Buffer Field Definitions'
literal
INPUT_MESSAGE_SIZE = 256,
OUTPUT_MESSAGE_SIZE = 256,
MESSAGE_BLOCK_SIZE = 63,
ERROR_BLOCK_SIZE = 63;
$field WORK_BUFFER_FIELDS =
set
WB_INPUT_MESSAGE = [$sub_block(INPUT_MESSAGE_SIZE)],
WB_OUTPUT_MESSAGE = [$sub_block(OUTPUT_MESSAGE_SIZE)],
WB_MESSAGE_ARGPTR = [$sub_block(1)],
WB_MESSAGE_BLOCK = [$sub_block(MESSAGE_BLOCK_SIZE)],
WB_ERROR_ARGPTR = [$sub_block(1)],
WB_ERROR_BLOCK = [$sub_block(ERROR_BLOCK_SIZE)],
$overlay (WB_ERROR_BLOCK)
WB_ERROR_CODE = [$integer]
$continue
tes;
literal
WORK_BUFFER_SIZE = $field_set_size;
macro WORK_BUFFER =
block [WORK_BUFFER_SIZE] field (WORK_BUFFER_FIELDS) %;
%sbttl 'AC Block Field Definitions'
$field AC_FIELDS =
set
$0 = [$fullword],
$1 = [$fullword],
$2 = [$fullword],
$3 = [$fullword],
$4 = [$fullword],
$5 = [$fullword],
$6 = [$fullword],
$7 = [$fullword],
$10 = [$fullword],
$11 = [$fullword],
$12 = [$fullword],
$13 = [$fullword],
$14 = [$fullword],
$15 = [$fullword],
$16 = [$fullword],
$17 = [$fullword]
tes;
literal
$AC_FIELD_SIZE = $field_set_size;
macro AC_BLOCK =
block [$AC_FIELD_SIZE]
field (AC_FIELDS) %;
%sbttl 'TOPS-20 Software Interrrupt System Macros'
macro USER_SETTABLE_CHANNELS =
0, 1, 2, 3, 4, 5, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34 %;
literal
$COMMAND_CHANNEL = 35;
macro INITIALIZE_CHANNELS (COUNT, CHANNEL) [] =
%if %count geq COUNT
%then %exititeration %fi
%if %count gtr 0
%then , %fi
CHANNEL
INITIALIZE_CHANNELS (COUNT, %remaining) %;
macro INTERRUPT_CHANNELS (COUNT) =
vector [COUNT]
initial (INITIALIZE_CHANNELS (COUNT, USER_SETTABLE_CHANNELS)) %;
%sbttl 'Sna Trace Protocol Literals'
literal ! SNT Protocol message types
ST$NUL = 00, ! No response available
ST$INI = 01, ! Initiate Trace
ST$STR = 02, ! Start Trace
ST$DAT = 03, ! Record Data
ST$STP = 04; ! Stop Trace (a ^Z was typed)
literal ! Host processor types
HP_GTW = 0, ! Gateway
HP_VMS = 1, ! VMS
HP_RSX = 2, ! RSX
HP_POS = 3, ! POS
HP_TOPS = 4; ! TOPS
%sbttl 'Miscelaneous Field Definitions'
$field SIGNED_BYTE_FIELDS =
set
VALUE = [0,0,8,1] ! Signed eight bit byte
tes;
macro $SIGNED_BYTE_VALUE =
block [1] field (SIGNED_BYTE_FIELDS) %;
$field DATA_ID_FIELDS = ! NICE protocol data id fields
set
DI_PARAMETER = [$bits(12)], ! Parameter type number
DI_MAPPED = [$bit], ! Counter bit map flag
DI_WIDTH = [$bits(2)], ! Counter width
DI_TYPE = [$bit], ! Type of data, counter or parameter
$overlay (DI_PARAMETER)
DI_COUNTER = [$bits(12)] ! Counter type number
$continue
tes;
macro $DATA_ID_BYTE =
block [1] field (DATA_ID_FIELDS) %;
$field DATA_TYPE_FIELDS = ! NICE protocol data type fields
set
DT_NUMBER = [$bits(6)], ! Number of bytes or fields
DT_FIELDS = [$bit], ! Single or multiple fields
DT_CODED = [$bit], ! Coded or not coded
$overlay(DT_NUMBER)
DT_LENGTH = [$bits(4)], ! Length of binary number
DT_FORMAT = [$bits(2)], ! Format of number
$continue
$overlay(DT_FIELDS)
DT_ASCII = [$bit] ! Field type, ASCII or binary number
$continue
tes;
macro $DATA_TYPE_BYTE =
block [1] field (DATA_TYPE_FIELDS) %;
%sbttl 'Functional Specification Literals'
literal ! SNT Routine Return Codes
RC_SUC = $TRUE, ! Success
RC_ERR = $FALSE; ! Error (additional error message
literal ! SNT trace states
RS_UND = 0, ! Undefined
RS_DSC = 3, ! Not Connected
RS_VER = 5, ! Version Verification
RS_CLR = 6, ! Clear
RS_LOD = 8, ! Load
RS_INI = 9, ! Initializing
RS_ERR = 10; ! Error
%sbttl 'Input Output Block Field Definitions'
literal
$IOB_STACK_SIZE = 256;
$field INPUT_OUTPUT_BLOCK_FIELDS =
set
IOB_FLAGS = [$fullword],
IOB_TRANSMIT_HANDLE = [$fullword],
IOB_RECEIVE_HANDLE = [$fullword],
IOB_TRANSMIT_BUFFER = [$address],
IOB_RECEIVE_BUFFER = [$address],
IOB_TRANSMIT_STACK = [$address],
IOB_RECEIVE_STACK = [$address],
IOB_TRANSMIT_AC_BLOCK = [$sub_block($AC_FIELD_SIZE)],
IOB_RECEIVE_AC_BLOCK = [$sub_block($AC_FIELD_SIZE)],
$overlay (IOB_FLAGS)
IOB_TRANSMIT_BUSY = [$bit],
IOB_RECEIVE_BUSY = [$bit]
$continue
tes;
literal
INPUT_OUTPUT_BLOCK_SIZE = $field_set_size;
macro INPUT_OUTPUT_BLOCK =
block [INPUT_OUTPUT_BLOCK_SIZE]
field (INPUT_OUTPUT_BLOCK_FIELDS) %;
%sbttl 'Memory Buffer Header Block Field Definitions'
! MEMORY_BUFFER
!
! The following fields are defined as memory buffer header
!
! MBH_FLAGS Flags
! MBH_LOCK Indicating if unit is available for allocation.
! 1, if unit is already allocated
! 0, unit is available
! MBH_CLUSTER Indicating if the following unit is part of a
! chain of units being allocated together. This flag
! only indicates that the following unit belongs to
! the same chain with the current one, which is being
! examined. This flag should not be used for making
! reference to the previous buffer unit.
!
! MBH_IDENTIFIER Identifier of this buffer.
!
! MBH_FORWARD_LINK Identifier of the following unit in the linked list.
!
! MBH_BACKWARD_LINK Identifier of the previous unit in the linked list.
literal
$MEMORY_BUFFER_UNITS = 200, ! Number of memory buffers
$MEMORY_BUFFER_SIZE = 32, ! Buffer size in words
$MEMORY_POOL_SIZE = $MEMORY_BUFFER_UNITS * $MEMORY_BUFFER_SIZE;
macro MEMORY_BUFFER_POOL =
vector [$MEMORY_POOL_SIZE] %;
macro MEMORY_MAP =
rep $MEMORY_BUFFER_UNITS of (rep ($MEMORY_BUFFER_SIZE - 1) of (0), -1) %;
$field MEMORY_BUFFER_HEADER_FIELDS =
set
MBH_FLAGS = [$byte],
MBH_IDENTIFIER = [$tiny_integer],
MBH_FORWARD_LINK = [$tiny_integer],
MBH_BACKWARD_LINK = [$tiny_integer],
$overlay (MBH_FLAGS)
MBH_LOCK = [$bit],
MBH_CLUSTER = [$bit]
$continue
tes;
literal
$MEMORY_BUFFER_HEADER_SIZE = $field_set_size,
$MEMORY_HEADERS = $MEMORY_BUFFER_HEADER_SIZE * $MEMORY_BUFFER_UNITS;
macro MEMORY_BUFFER_HEADER =
block [$MEMORY_BUFFER_HEADER_SIZE]
field (MEMORY_BUFFER_HEADER_FIELDS) %;
macro MEMORY_BUFFER_HEADERS =
blockvector [$MEMORY_BUFFER_UNITS, $MEMORY_BUFFER_HEADER_SIZE]
field (MEMORY_BUFFER_HEADER_FIELDS) %;
%sbttl 'Memory Control Block Field Definitions'
! MEMORY_CONTROL_BLOCK
!
! The following fields are defined as memory allocation control values
!
! MCB_ALLOCATED_HEAD Identifier of the first buffer in the allocated
! linked list. Initially -1.
! MCB_ALLOCATED_TAIL Identifier of the last buffer in the allocated
! linked list. Initially -1.
! New allocated buffer are linked to the list using
! this field.
! MCB_FREE_HEAD Identifier of the first buffer in the free linked
! list. Initially 0 (first free unit).
! New free buffer to be allocated is to be removed from
! the list using this field.
! MCB_FREE_TAIL Identifier of the last buffer in the free linked list.
! MCB_HEADERS Area of buffer headers.
$field MEMORY_CONTROL_BLOCK_FIELDS =
set
MCB_ALLOCATED_HEAD = [$tiny_integer],
MCB_ALLOCATED_TAIL = [$tiny_integer],
MCB_FREE_HEAD = [$tiny_integer],
MCB_FREE_TAIL = [$tiny_integer],
MCB_HEADERS = [$sub_block($MEMORY_HEADERS)]
tes;
literal
MEMORY_CONTROL_BLOCK_SIZE = $field_set_size;
macro MEMORY_CONTROL_BLOCK =
block [MEMORY_CONTROL_BLOCK_SIZE]
field (MEMORY_CONTROL_BLOCK_FIELDS) %;
%sbttl 'System Identification Block Field Definitions'
$field SYSTEM_INFORMATION_BLOCK_FIELDS =
set
SIB_SYSTEM_NAME = [$sub_block(2)],
SIB_SYSTEM_VERSION = [$address]
tes;
literal
SYSTEM_INFORMATION_BLOCK_SIZE = $field_set_size;
macro SYSTEM_INFORMATION_BLOCK =
block [SYSTEM_INFORMATION_BLOCK_SIZE]
field (SYSTEM_INFORMATION_BLOCK_FIELDS) %;
%sbttl 'SNT Global Control Block Field Definitions'
$field GLOBAL_CONTROL_BLOCK_FIELDS =
set
GCB_VERSION = [$byte],
GCB_MINOR = [$byte],
GCB_EDIT = [$byte],
GCB_FLAGS = [$byte],
GCB_START_CLOCK = [$fullword],
GCB_END_CLOCK = [$fullword],
GCB_EXEC_HANDLE = [$fullword],
GCB_COMMAND_STRING = [$address],
GCB_CPU_TIME = [$address],
GCB_SYSTEM_INFORMATION_BLOCK = [$sub_block(SYSTEM_INFORMATION_BLOCK_SIZE)],
GCB_INPUT_OUTPUT_BLOCK = [$sub_block(INPUT_OUTPUT_BLOCK_SIZE)],
GCB_MEMORY_CONTROL_BLOCK = [$sub_block(MEMORY_CONTROL_BLOCK_SIZE)],
$overlay (GCB_FLAGS)
GCB_CONTROL_FLAGS = [$bits(4)],
GCB_DEBUG_FLAGS = [$bits(5)],
$continue
$overlay (GCB_CONTROL_FLAGS)
GCB_EXIT = [$bit],
GCB_LOGGING = [$bit],
$continue
$overlay (GCB_DEBUG_FLAGS)
GCB_DEBUG_CALLS = [$bit],
GCB_DEBUG_RECEPTION = [$bit],
GCB_DEBUG_TRANSMISSION = [$bit],
GCB_DEBUG_BUFFER_ALLOCATION = [$bit]
$continue
tes;
literal
$GLOBAL_CONTROL_BLOCK_SIZE = $field_set_size;
macro GLOBAL_CONTROL_BLOCK =
block [$GLOBAL_CONTROL_BLOCK_SIZE]
field (GLOBAL_CONTROL_BLOCK_FIELDS) %;
%sbttl 'ENQUEUE And DEQUEUE Field Definitions'
$field ENQUEUE_DEQUEUE_FIELDS =
set
EDQ_LN = [$fullword],
EDQ_ID = [$fullword],
EDQ_LV = [$fullword],
EDQ_UC = [$fullword],
EDQ_RS = [$fullword],
EDQ_MS = [$fullword]
tes;
literal ! ENQ/DEQ resource codes
$BUFFER_POOL = (%O'500000' ^ 18);
literal
ENQUEUE_DEQUEUE_SIZE = $field_set_size;
macro ENQUEUE_DEQUEUE_BLOCK =
block [ENQUEUE_DEQUEUE_SIZE]
field (ENQUEUE_DEQUEUE_FIELDS) %;
%sbttl 'Debugging Macro'
macro DEBUG_SWITCH_LIST =
'DEBUG_FORK', 'DB.FRK'
%;
macro DEBUG_BIT [NAME, BIT_NAME] =
%name (NAME,'_FLAG') = [$bit] %;
$field DEBUG_BIT_FIELDS =
set
DEBUG_BIT (DEBUG_SWITCH_LIST)
tes;
literal
DEBUG_BIT_SIZE = $field_set_size;
macro DEBUG_FLAGS =
DEBUG: block [DEBUG_BIT_SIZE] field (DEBUG_BIT_FIELDS) %;
macro DEBUG_LITERAL [NAME, BIT_NAME] =
%name (BIT_NAME) = 1 ^ (%fieldexpand (%name (NAME,'_FLAG'), 1)) %;
macro DEBUG_SWITCHES =
DEBUG_LITERAL (DEBUG_SWITCH_LIST),
%name ('DB.ALL') = -1
%;
%sbttl 'Error Messages'
macro ERROR_MESSAGE_LIST =
(ERROR, 'Error Message')
%;
macro $ERROR_CODE_ENTRY$ (CODE, STRING, VALUE) =
%print (' ERR_', CODE, ' = ', VALUE, ' "', STRING, '"')
%name ('ERR_',CODE) = VALUE %;
macro ERROR_CODES [LIST] =
$ERROR_CODE_ENTRY$ (%remove (LIST), %count) %;
literal
ERROR_CODES (ERROR_MESSAGE_LIST);
$field ERROR_MESSAGE_BLOCK_FIELDS =
set
ERB_MESSAGE = [$pointer]
tes;
literal
ERROR_MESSAGE_BLOCK_SIZE = $field_set_size;
macro ERROR_MESSAGES_BLOCK =
blockvector [LIST_COUNT (ERROR_MESSAGE_LIST), ERROR_MESSAGE_BLOCK_SIZE]
field (ERROR_MESSAGE_BLOCK_FIELDS) %;
macro $ERROR_MESSAGE_ENTRY$ (CODE, STRING, COUNT) =
[COUNT, ERB_MESSAGE] = CH$ASCIZ (%string (STRING)) %;
macro $ERROR_MESSAGES$ [LIST] =
$ERROR_MESSAGE_ENTRY$ (%remove (LIST), %count) %;
macro ERROR_MESSAGES =
$ERROR_MESSAGES$ (ERROR_MESSAGE_LIST) %;
%sbttl 'Event Messages'
macro EVENT_MESSAGE_LIST =
(EVENT, 'Event Message')
%;
macro $EVENT_CODE_ENTRY$ (CODE, STRING, VALUE) =
%print (' EVT_', CODE, ' = ', VALUE, ' "', STRING, '"')
%name ('EVT_',CODE) = VALUE %;
macro EVENT_CODES [LIST] =
$EVENT_CODE_ENTRY$ (%remove (LIST), %count) %;
literal
EVENT_CODES (EVENT_MESSAGE_LIST);
$field EVENT_MESSAGE_BLOCK_FIELDS =
set
EVB_MESSAGE = [$pointer]
tes;
literal
EVENT_MESSAGE_BLOCK_SIZE = $field_set_size;
macro EVENT_MESSAGES_BLOCK =
blockvector [LIST_COUNT (EVENT_MESSAGE_LIST), EVENT_MESSAGE_BLOCK_SIZE]
field (EVENT_MESSAGE_BLOCK_FIELDS) %;
macro $EVENT_MESSAGE_ENTRY$ (CODE, STRING, COUNT) =
[COUNT, EVB_MESSAGE] = CH$ASCIZ (%string (STRING)) %;
macro $EVENT_MESSAGES$ [LIST] =
$EVENT_MESSAGE_ENTRY$ (%remove (LIST), %count) %;
macro EVENT_MESSAGES =
$EVENT_MESSAGES$ (EVENT_MESSAGE_LIST) %;
%sbttl 'Command Parser Dispatch Fields'
$field COMMAND_PARSER_DISPATCH_FIELDS =
set
CPD_ROUTINE = [$fullword] ! Dispatch routine address
tes;
literal
COMMAND_PARSER_DISPATCH_SIZE = $field_set_size;
macro COMMAND_LIST =
(CMDANL,CEX$ANALYZE),
(CMDDDT,CEX$DDT),
(CMDDEB,CEX$DEBUG),
(CMDEXT,CEX$EXIT),
(CMDHLP,CEX$HELP),
(CMDPSH,CEX$PUSH),
(CMDTAK,CEX$TAKE),
(CMDTRA,CEX$TRACE) %;
macro $COMMAND_LOOKUP$ [LIST] =
$COMMAND_ENTRY$ (%remove (LIST)) %;
macro $COMMAND_ENTRY$ (COMMAND, DISPATCH) =
[COMMAND, CPD_ROUTINE] = DISPATCH %;
literal
NUMBER_OF_COMMANDS = LIST_COUNT (COMMAND_LIST);
macro COMMAND_DISPATCH_ENTRIES =
blockvector [NUMBER_OF_COMMANDS,COMMAND_PARSER_DISPATCH_SIZE]
field (COMMAND_PARSER_DISPATCH_FIELDS)
preset ($COMMAND_LOOKUP$ (COMMAND_LIST)) %;
%sbttl 'External Interface Macros'
macro BLISS_PSI_ROUTINES =
PSIAIC, ! Activate Interrupt Channels
PSIATI, ! Assign Terminal Interrupt Code
PSICIS, ! Clear Interrupt System
PSIDIC, ! Deactivate Interrupt Channel
PSIDIR, ! Disable Interrupt System
PSIDTI, ! Deassign Terminal Interrupt Code
PSIEIR, ! Enable Interrupt System
PSIINT, ! Interrupt handler definition
PSIRST, ! Resume Suspended Process
PSISIR, ! Set up PSI table
PSISKP, ! Test Software Interrupt System
PSIWAI ! Suspend Current Process for 50ms
%;
$field INITIAL_BLOCK_FIELDS =
set
IB_PROGRAM = [$sub_blockx(6)]
tes;
literal
INITIAL_BLOCK_SIZE = $field_set_size;
macro INITIAL_BLOCK =
block [INITIAL_BLOCK_SIZE]
field (INITIAL_BLOCK_FIELDS) %;
$field PARSE_BLOCK_FIELDS =
set
PB_TB = [$fullword],
PB_PM = [$fullword],
PB_CM = [$fullword],
PB_SR = [$fullword]
tes;
literal
PARSE_BLOCK_SIZE = $field_set_size;
macro PARSE_BLOCK =
block [PARSE_BLOCK_SIZE]
field (PARSE_BLOCK_FIELDS) %;
$field PARSER_RETURN_BLOCK_FIELDS =
set
PRB_FL = [$fullword],
PRB_CM = [$fullword],
PRB_CF = [$fullword],
PRB_MS = [$fullword],
PRB_EM = [$fullword],
PRB_EC = [$fullword]
tes;
literal
PARSER_RETURN_BLOCK_SIZE = $field_set_size;
macro PARSER_RETURN_BLOCK =
block [PARSER_RETURN_BLOCK_SIZE]
field (PARSER_RETURN_BLOCK_FIELDS) %;
$field COMMAND_BLOCK_FIELDS =
set
CB_MH = [$sub_blockx(5)], ! Message header (3) + FLAG + ARG COUNT
CB_TY = [$fullword], ! Command object type
CB_SN = [$fullword], ! Source node
CB_PB = [$fullword], ! Offset to Parser Block
CB_CM = [$fullword] ! Offset to text of command
tes;
literal
COMMAND_BLOCK_SIZE = $field_set_size;
macro COMMAND_BLOCK =
block [COMMAND_BLOCK_SIZE]
field (COMMAND_BLOCK_FIELDS) %;
macro MESAGE_ROUTINES =
MESEMC: GALAXY %;
macro GLXLIB_ROUTINES =
I_INIT: GALAXY,
K_SOUT: GALAXY,
PARSER: GALAXY,
P$ACCT: GALAXY,
P$CFM: GALAXY,
P$COMMA: GALAXY,
P$CURR: GALAXY,
P$DEV: GALAXY,
P$DIR: GALAXY,
P$FILE: GALAXY,
P$FLD: GALAXY,
P$FLOT: GALAXY,
P$HELP: GALAXY,
P$IFIL: GALAXY,
P$KEYW: GALAXY,
P$NARG: GALAXY,
P$NEXT: GALAXY,
P$NFLD: GALAXY,
P$NODE: GALAXY,
P$NUM: GALAXY,
P$OFIL: GALAXY,
P$PREV: GALAXY,
P$QSTR: GALAXY,
P$RNGE: GALAXY,
P$SETUP: GALAXY,
P$SIXF: GALAXY,
P$SWIT: GALAXY,
P$TEXT: GALAXY,
P$TIME: GALAXY,
P$TOK: GALAXY,
P$UQSTR: GALAXY,
P$USER: GALAXY %;
%sbttl 'Routine Name Mapping'
macro %ROUTINE (NAME) =
%sbttl %string (NAME %if not %identical (NAME, %string (%name (NAME)))
%then ,' (', %name (NAME), ')' %fi)
routine %name (NAME)
%if %length gtr 1
%then (%remaining) %fi %;
macro %GLOBAL_ROUTINE (NAME) =
%sbttl %string (NAME %if not %identical (NAME, %string (%name (NAME)))
%then ,' (', %name (NAME), ')' %fi)
global routine %name (NAME)
%if %length gtr 1
%then (%remaining) %fi %;
macro ! MESAGE routines
MES$EXPAND_CODE = MESEMC %;
macro ! TXTLIB routines
TXT$WRITE = TXTWRT %;
macro ! SNTANA routines
ANA$ANALYZE = ANALYZ %;
macro ! SNTCEX routines
CEX$ANALYZE = CEXANL %,
CEX$DDT = CEXDDT %,
CEX$DEBUG = CEXDEB %,
CEX$EXIT = CEXEXI %,
CEX$HELP = CEXHLP %,
CEX$PARSE_NODESPEC = CEXPND %,
CEX$PUSH = CEXPSH %,
CEX$SERVICE = CEXSER %,
CEX$TAKE = CEXTAK %,
CEX$TRACE = CEXTRA %,
CEX$COMMAND_EXECUTOR = CEXCEX %,
CEX$PARSE_NODE = CEXPND %,
CEX$PARSE_COMMAND_LINE = CEXPCL %,
CEX$PARSE_COMMAND_FILE = CEXPCF %,
CEX$COMMAND_PARSER = CEXPAR %;
macro ! SNTFIL routines
FIL$BUILD_HEADER_RECORD = FILBHR %,
FIL$CLOSE_ANALYZE_FILE = FILCAL %,
FIL$CLOSE_OUTPUT_FILE = FILCOF %,
FIL$CLOSE_TRACE_FILE = FILCTF %,
FIL$CLOSE_NETWORK = FILNET %,
FIL$GET_COUNT = FILCNT %,
FIL$GET_RECORD = FILGR %,
FIL$OPEN_ANALYZE_FILE = FILOAF %,
FIL$OPEN_OUTPUT_FILE = FILOOF %,
FIL$OPEN_TRACE_FILE = FILOTF %,
FIL$TERMINATE_TRACE = FILTER %,
FIL$PURGE = FILPUR %,
FIL$TIME_STAMP = FILTMS %,
FIL$TIME_ZONE = FILTMZ %,
FIL$VERIFY_HEADER_RECORD = FILVHR %,
FIL$WRITE_END_RECORD = FILEND %,
FIL$WRITE_HEADER_RECORD = FILHDR %,
FIL$WRITE_RECORD = FILREC %;
macro
FRK$RECEIVE = FRKRCV %,
FRK$SLEEPER = FRKWAI %,
FRK$START_INFERIOR_FORK = FRKSIF %;
macro ! SNTMEM routines
MEM$GET = MEMGET %,
MEM$GET_MULTIPLE_BUFFERS = MEMGTM %,
MEM$GET_SINGLE_BUFFER = MEMGTS %,
MEM$INITIALIZE = MEMINI %,
MEM$RELINK = MEMLNK %,
MEM$RETURN = MEMRET %;
macro ! SNTNMI routines
NMI$GATEWAY_NODE_NAME = NMIGNN %,
NMI$GET_ACCESS_INFORMATION = NMIGAI %,
NMI$SCAN_ACCESS_INFORMATION = NMISAI %,
NMI$SCAN_SINGLE_FIELD = NMISSF %;
macro ! SNTPIC routines
PIC$CLEAR_ANALYZER_PARAMETERS = PICCAP %,
PIC$CLEAR_PORT_PARAMETERS = PICCPP %,
PIC$DEFINABLE = PICDFA %,
PIC$DEFINE_PARAMETERS = PICDEF %,
PIC$PORT_NUMBER = PICPID %,
PIC$SHOW_PORTS = PICSHW %;
macro ! SNTPSI routines
PSI$TTY_INIT = PSIINI %,
PSI$TTY_RESTORE = PSIRES %,
PSI$ENABLE_INTERRUPTS = PSIENA %,
PSI$DISABLE_INTERRUPTS = PSIDIS %;
macro ! SNTREX routines
REX$ABORT = REXABT %,
REX$ANALYZE = REXANL %,
REX$DEBUG = REXDEB %,
REX$SERVICE_REQUEST = REXRSP %,
REX$TRACE = REXTRA %;
macro ! SNTTRC routines
TRC$TRACE = TRCTRA %,
TRC$SET_DEFAULTS = TRCDEF %,
TRC$FILELOOP = TRCFLP %,
TRC$START = TRCSTA %,
TRC$LOOP = TRCLP %,
TRC$STOP = TRCSTP %,
TRC$CTRLZ_TRAP = TRCZTR %;
macro ! SNTMSG routines
MSG$WRITE_HEADER_RECORD = MSGHDR %,
MSG$WRITE_RECORD = MSGREC %,
MSG$WRITE_END_RECORD = MSGEND %,
MSG$EXPAND_EVENT = MSGEVT %,
MSG$EXPAND_ERROR = MSGERR %,
MSG$FORMAT_MESSAGE = MSGFMT %,
MSG$PRINT_MESSAGE = MSGPRI %,
MSG$FORMAT_LH = MSGFLH %,
MSG$FORMAT_TH = MSGFTH %,
MSG$FORMAT_RH = MSGFRH %,
MSG$BUILD_OUTPUT = MSGBOU %,
MSG$FORMAT_DATA = MSGDAT %,
MSG$PROCESS_MESSAGE_BLOCK = MSGPMB %;
macro ! SNTUSP routines
USP$AUTHORIZATION = USPAUT %,
USP$GET_TIME_STAMP = USPGTS %,
USP$PUT_TIME_STAMP = USPPTS %,
USP$TIME_ZONE = USPZON %,
USP$PLURALIZE = USPPLU %,
USP$ERROR_MESSAGE = USPERR %,
USP$FINAL_STATISTICS = USPFIN %,
USP$LOCK = USPLCK %,
USP$RESET_CONTROL = USPRCT %,
USP$RESET_TERMINAL = USPRTT %,
USP$RUN_TIME = USPRTM %,
USP$SYSTEM_IDENTIFICATION = USPSYS %,
USP$TRANSLATE_SNAGAT = USPTRN %,
USP$UNLOCK = USPUNL %;
macro ! Special utility support routines
USP$BUFFER_INITIALIZE = BUFINI %,
USP$DYNAMIC_DEBUGGING_TOOL = UDDT %;
!
! SNA Gateway Access DECnet Function Routines
!
macro ! XGADNF routines
GAD$ABORT_LINK = GADABT %,
GAD$ABORT_REASON = GADRSN %,
GAD$DISCONNECT_LINK = GADDIS %,
GAD$LINK_STATUS = GADSTA %,
GAD$NETWORK_DESCRIPTOR = GADNET %,
GAD$OPEN_LINK = GADOPN %,
GAD$OPEN_SERVER = GADSRV %,
GAD$PROTOCOL_TYPE = GADTYP %,
GAD$PSI_CHANNELS = GADPSI %,
GAD$RECEIVE_DATA = GADRCV %,
GAD$RECEIVE_INTERRUPT = GADRCI %,
GAD$SEND_DATA = GADSND %,
GAD$SEND_INTERRUPT = GADSNI %;
!
! SNA Gateway Access Macro Interface Routines
!
macro ! SGATRM routines
GAM$EXECUTE_REQUEST = GAMEXE %,
GAM$SEND_REQUEST = GAMSND %,
GAM$RECEIVE_RESPONSE = GAMRCV %,
GAM$ABORT_REASON = GAMABO %,
GAM$ASCIZ = GAMASZ %,
GAM$ASCIC = GAMASC %;
!
! SNA Gateway SNT Protocol Input/Output Routines
!
macro ! SGAPRI routines
GAP$RI_STR = GRISTR %,
GAP$RI_DAT = GRIDAT %,
GAP$RI_COPY = GRICPY %,
GAP$RI_PROTOCOL_TYPE = GRITYP %;
macro ! SGAPRO routines
GAP$RO_INI = GROINI %,
GAP$RO_ASSEMBLE = GROASM %,
GAP$RO_LTF = GROLTF %,
GAP$RO_LTT = GROLTT %;
macro ! SGAPRE routines
GAE$MAP_ERROR = GAEMAP %;
%sbttl 'Special Linkages'
linkage FORK = ! SNT fork subprocess linkage
pushj:
linkage_regs (15,13,1)
nopreserve (0,2,3,4,5,6,7,8,9,10,11,12,14);
linkage MAC = ! SNA Gateway Access routine linkage
pushj (register=1):
linkage_regs (15,13,0)
preserve (0,1,2,3,4,5,6,7,8,9,10,11,12,14);
linkage GALAXY = ! GALAXY routine linkage
pushj (register=1, register=2; register=1, register=2):
linkage_regs (15,14,0)
nopreserve (0,1,2,3,4)
preserve (5,6,7,8,9,10,11,12,13);
%title '' %sbttl ''
! Local Modes:
! Mode:BLISS
! Auto Save Mode:2
! Comment Column:40
! Comment Rounding:+1
! End: