Programmer's ROM - The Computer Language Library

home *** CD-ROM | disk | FTP | other *** search

/ Programmer's ROM - The Computer Language Library / programmersrom.iso / ada / defdata / iface.src < prev next >

Wrap

Text File | 1988-05-03 | 47.7 KB | 1,290 lines

--:::::::::::::: --ulp_buffer_.ada --:::::::::::::: ----------------------------------------------------------------------- -- -- DoD Protocols NA-00002-200 80-01034-100(-) -- E-Systems, Inc. August 07, 1985 -- -- ULP_BUFFER_.ADA Author : Jim Baldo -- ----------------------------------------------------------------------- with SYSTEM; use SYSTEM; package BUFFER_DATA is ----------------------------------------------------------------------------- --This package represents the data abstraction of a message that travels -- --through each layer in the DoD reference model. Upon recieving a message -- --the protocol uses a pointer to gain access to the beginning of its -- --header. The package is implementation dependent. Its intend is to -- --facilatate the portibility of this communications program by narrowing -- --the packages to be change to an absolute minimum for different machines. -- -- -- --design: -- -- -- -- -- -- The packed bit stream buffer definition. -- -- A buffer record contains the following information: -- -- STATUS : indicating the current owner, if any. A process must not -- -- free a buffer if it is owned by any other process. -- -- TELNET_PTR : indicates the position of the first byte of data for -- -- Telnet. -- -- TCP_PTR : indicates the position of the first byte of data for TCP.-- -- IP_PTR : indicates the position of the first byte of data for IP. -- -- SUBNET_PTR : Indicates the position of the first byte of data -- -- for SUBNET -- -- SIZE : total size in bytes -- -- BYTE : The actual transmitted data, in an array of packed bytes.-- -- NEXT : A link field used to manage free buffers. -- -- -- -- -- -- -- -- Organization of buffer -- -- Note that unused portion of the buffer is at the front or the back-- -- of the buffer. -- -- -- -- +-------------+ -- -- | | -- -- | unused | -- -- | | -- -- +-------------+ <-------- SUBNET_PTR -- -- | | -- -- | SUBNET | -- -- | header | -- -- | | -- -- +-------------+ <-------- IP_PTR -- -- | | -- -- | IP | -- -- | header | -- -- | | -- -- +-------------+ <-------- TCP_PTR -- -- | | -- -- | TCP | -- -- | header | -- -- | | -- -- +-------------+ <-------- TELNET_PTR -- -- | | -- -- | TELNET | -- -- | data | -- -- | | -- -- +-------------+ -- -- | | -- -- | unused | -- -- | | -- -- +-------------+ -- -- -- ----------------------------------------------------------------------------- subtype THIRTYTWO_BITS is INTEGER; -- DEC/Ada --TEL subtype THIRTYTWO_BITS is INTEGER; --Telesoft Ada version 1.5 subtype SIXTEEN_BITS is SHORT_INTEGER; -- DEC/Ada --TEL subtype SIXTEEN_BITS is SHORT_INTEGER; --Telesoft Ada version 1.5 subtype SYSTEM_BYTE is UNSIGNED_BYTE; -- DEC/Ada --TEL subtype SYSTEM_BYTE is SYSTEM.BYTE; -- Telesoft Ada version 1.5 MAXIMUM_DATAGRAM_SIZE : constant SIXTEEN_BITS := 576; type BUFFER_STATUS is (NONE, OWNER_TELNET, OWNER_TCP, OWNER_IP, OWNER_X25); type BUFFER_AREA IS ARRAY(1..MAXIMUM_DATAGRAM_SIZE) OF SYSTEM_BYTE; TELNET_SIZE : constant SIXTEEN_BITS := 512; --for efficent block transfe TCP_SIZE : constant SIXTEEN_BITS := 512; IP_SIZE : constant SIXTEEN_BITS := 512; SUBNET_SIZE : constant SIXTEEN_BITS := 512; --set appropiately to SUBNET --specification subtype TELNET_PTR_TYPE is SIXTEEN_BITS range 0..TELNET_SIZE; subtype TCP_PTR_TYPE is SIXTEEN_BITS range 0..TCP_SIZE; subtype IP_PTR_TYPE is SIXTEEN_BITS range 0..IP_SIZE; subtype SUBNET_PTR_TYPE is SIXTEEN_BITS range 0..SUBNET_SIZE; type PACKED_BUFFER; type PACKED_BUFFER_PTR is access PACKED_BUFFER; type PACKED_BUFFER is record STATUS : BUFFER_STATUS := NONE; IN_USE : BOOLEAN := false; -- THE LAYER USING IT MAY NOT -- BE THE OWNER. SIZE : SIXTEEN_BITS range 0..MAXIMUM_DATAGRAM_SIZE; TELNET_PTR : TELNET_PTR_TYPE; TCP_PTR : TCP_PTR_TYPE; IP_PTR : IP_PTR_TYPE; SUBNET_PTR : SUBNET_PTR_TYPE; BYTE : BUFFER_AREA; NEXT : PACKED_BUFFER_PTR; end record; --type BUFFER_ERROR_TYPE is (RETURNING_A_BUFFER,OUT_OF_FREE_BUFFERS); procedure INIT; --This subprogram is called when the system is intialize to --create a finite number of buffers. procedure BUFFREE ( BUFPTR : in out PACKED_BUFFER_PTR; BUFFTYPE : in SIXTEEN_BITS ); --This subprogram frees a buffer to be used again. --Change buffer status to free and place it on a free list --of buffers. procedure BUFFGET ( BUFPTR : in out PACKED_BUFFER_PTR; BUFFTYPE : in SIXTEEN_BITS ); --This subprogram obtains a buffer to be used. end BUFFER_DATA; --:::::::::::::: --ulp_buffer.ada --:::::::::::::: ----------------------------------------------------------------------- -- -- DoD Protocols NA-00002-200 80-01035-100(-) -- E-Systems, Inc. August 07, 1985 -- -- ULP_BUFFER.ADA Author : Jim Baldo -- ----------------------------------------------------------------------- with UNCHECKED_CONVERSION; with TEXT_IO; use TEXT_IO; ---------------------------------------------------------------------------- -- -- Implementation for DEC VAX installation only! -- ---------------------------------------------------------------------------- package body BUFFER_DATA is package INT_IO is new INTEGER_IO( THIRTYTWO_BITS ); HEAD : PACKED_BUFFER_PTR; -- The pointer to the head of the buffer free BUFFER_COUNT : THIRTYTWO_BITS ; BUFFER_PRINT_FLAG : THIRTYTWO_BITS := 1; task buffer_manager is pragma priority (15) ; entry free (bufptr : in out packed_buffer_ptr) ; entry get (bufptr : out packed_buffer_ptr) ; end buffer_manager ; task body buffer_manager is begin loop select accept free (bufptr : in out packed_buffer_ptr) do bufptr.next := head; head := bufptr; end free ; or accept get (bufptr : out packed_buffer_ptr) do bufptr := head; if head /= null then head := head.next ; end if ; end get ; or terminate; end select ; end loop ; exception when others => put_line("ERROR IN BUFFER MANAGER") ; end buffer_manager ; -- -- The view from the outside world: -- procedure BUFFREE ( BUFPTR : in out PACKED_BUFFER_PTR; BUFFTYPE : in SIXTEEN_BITS ) is begin if BUFPTR.STATUS = NONE and then NOT BUFPTR.IN_USE then BUFFER_COUNT := BUFFER_COUNT + 1; -- if BUFFER_PRINT_FLAG /= 0 then --for debug only(JB 1/25/85) -- TEXT_IO.NEW_LINE; -- TEXT_IO.PUT("FREEING A BUFFER. NUMBER OF FREE BU"); -- TEXT_IO.INTEGER_IO.PUT(BUFFER_COUNT); -- TEXT_IO.NEW_LINE; -- end if; bufptr.in_use := true; buffer_manager.free(bufptr) ; bufptr := null; -- return a null pointer end if; exception when others => put_line("ERROR IN BUFFREE") ; end BUFFREE; procedure BUFFGET (BUFPTR : in out PACKED_BUFFER_PTR; BUFFTYPE : in SIXTEEN_BITS ) is begin buffer_manager.get(bufptr) ; if bufptr /= null then bufptr.in_use := false ; bufptr.telnet_ptr := 255 ; bufptr.tcp_ptr := 255 ; bufptr.ip_ptr := 255 ; bufptr.subnet_ptr := 255 ; bufptr.status := NONE ; else text_io.put_line("BUFFER_ERROR OUT_OF_FREE_BUFFERS") ; -- for debug end if ; if BUFFER_COUNT /= 0 then BUFFER_COUNT := BUFFER_COUNT - 1; end if; -- if BUFFER_PRINT_FLAG /= 0 then--for debug only (JB 1/25/85) -- if BUFFER_COUNT /= 0 then -- TEXT_IO.NEW_LINE; -- TEXT_IO.PUT -- ("GETTING A BUFFER. NUMBER OF FREE BU"); -- TEXT_IO.INTEGER_IO.PUT(BUFFER_COUNT); -- TEXT_IO.NEW_LINE; -- else -- TEXT_IO.PUT_LINE("NO FREE BUFFERS ON BUFFER GET"); -- end if; -- end if; exception when others => TEXT_IO.PUT_LINE("ERROR IN BUFFER GET"); raise ; end BUFFGET; procedure INIT is I : THIRTYTWO_BITS ; NEXT_BUFFER : PACKED_BUFFER_PTR; begin -- get one hundred and one buffers. HEAD := new PACKED_BUFFER; NEXT_BUFFER := new PACKED_BUFFER; HEAD.NEXT := NEXT_BUFFER; for I in 1..50 loop next_buffer := new packed_buffer; buffree(next_buffer,0) ; end loop; BUFFER_COUNT := 50; if BUFFER_PRINT_FLAG /= 0 then TEXT_IO.PUT("THE NUMBER OF INITIAL BUFFERS IS "); INT_IO.PUT(BUFFER_COUNT); TEXT_IO.NEW_LINE; end if; exception when STORAGE_ERROR => TEXT_IO.PUT_LINE("OUT OF ROOM TO INITIALIZE BUFFERS"); when others => TEXT_IO.PUT_LINE("ERROR IN INITIALIZE BUFFERS"); end INIT; -- -- Package initialization -- begin BUFFER_COUNT := 0; -- initialize buffer count. end BUFFER_DATA; --:::::::::::::: --ulp_ipglb_.ada --:::::::::::::: ----------------------------------------------------------------------- -- -- DoD Protocols NA-00002-200 80-01036-100(-) -- E-Systems, Inc. August 07, 1985 -- -- ULP_IPGLB_.ADA Author : Jim Baldo -- ----------------------------------------------------------------------- with BUFFER_DATA ; use BUFFER_DATA ; with SYSTEM; use SYSTEM; with TEXT_IO; use TEXT_IO; package IP_GLOBALS is ----------------------------------------------- --This implementation is for use with the -- --DEC/Ada compiler . -- ----------------------------------------------- ------------------------------------------------------------------------------ -- THIS SPECIFICATION CONTAINS ALL NECESSARY GLOBAL VARIABLES FOR THE -- -- INTERNET PROTOCOL. -- ------------------------------------------------------------------------------ subtype LOCAL_ADDRESS_TYPE is SIXTEEN_BITS ; NUMBER_OF_ADDRESSES : constant SIXTEEN_BITS := 4; -- TEMPORARY VALUE *** MAX_HOSTS : constant SIXTEEN_BITS := 4; -- TEMP. type MY_ADDRESS_LIST is array(1..MAX_HOSTS) of LOCAL_ADDRESS_TYPE ; type ADDRESS_LIST is array(1..NUMBER_OF_ADDRESSES) of THIRTYTWO_BITS ; VALID_ADDRESS_LIST : constant ADDRESS_LIST := (1, 2, 3, 128); MY_IP_ADDRESS : constant MY_ADDRESS_LIST := (1,2,3,128); -- TEMPORARY ** BAD_CHECKSUM : SIXTEEN_BITS := 0; WHOIAM : constant THIRTYTWO_BITS := 1 ; subtype SEVEN_BITS is SIXTEEN_BITS ; subtype TEN_BITS is SIXTEEN_BITS ; subtype THREE_BITS is SIXTEEN_BITS ; subtype TWO_BITS is SIXTEEN_BITS ; subtype FOUR_OCTETS is THIRTYTWO_BITS ; subtype TWO_OCTETS is SIXTEEN_BITS ; subtype ONE_OCTET is SIXTEEN_BITS ; subtype HALF_OCTET is SIXTEEN_BITS ; subtype SIX_BITS is SIXTEEN_BITS ; subtype ONE_BIT is SIXTEEN_BITS ; subtype BTYPE_TYPE is SIXTEEN_BITS ; subtype OPTION_TYPE_RANGE is SIXTEEN_BITS range 1..50; type OPTION_TYPE is array(OPTION_TYPE_RANGE) of SIXTEEN_BITS ; type BUFFER_POINTER is record BTYPE : BTYPE_TYPE; VERSION : HALF_OCTET; IHL : HALF_OCTET; TOS : ONE_OCTET; TOT_LEN : TWO_OCTETS; ID : TWO_OCTETS; FLAGS : THREE_BITS; FRAG_OFFSET : TWO_OCTETS; TTL : ONE_OCTET; PROT : ONE_OCTET; IPCSUM : TWO_OCTETS; SOURCE : FOUR_OCTETS; DEST : FOUR_OCTETS; --OPTIONS FOR IP HERE. IP_OPTIONS : OPTION_TYPE := (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0); end record; type PRECEDENCE_TYPE is ( NETWORK_CONTROL, -- 111 INTERNETWORK_CONTROL, -- 110 CRITIC_ECP, -- 101 FLASH_OVERRIDE, --100 FLASH, --011 IMMEDIATE, --010 PRIORITY, --001 ROUTINE); --000 type RELIABILITY_TYPE is ( NORMAL, HIGH); type DELAY_TYPE is ( NORMAL, LOW); type THROUGHPUT_TYPE is ( NORMAL, HIGH); subtype DATAGRAM_LENGTH is SIXTEEN_BITS ; type RESULT_TYPE is (OK, NOK); type IP_ACTION is ( IP_SEND, ERROR_MESSAGE, DATA_FROM_SUBNET, FROM_TCP, RECEIVE_IP, NO_IP_ACTION ) ; type IP_MESSAGE(EVENT : IP_ACTION := IP_SEND) is record BUFPTR : PACKED_BUFFER_PTR := null; case EVENT is when IP_SEND => LOCAL_DESTINATION : LOCAL_ADDRESS_TYPE ; PRECEDENCE : PRECEDENCE_TYPE := ROUTINE; RELIABILITY : RELIABILITY_TYPE := NORMAL; DELAY_IP : DELAY_TYPE := NORMAL; THROUGHPUT : THROUGHPUT_TYPE := NORMAL; LENGTH : DATAGRAM_LENGTH := 0 ; when ERROR_MESSAGE => ERROR_NUMBER : SIXTEEN_BITS ; when RECEIVE_IP => SOURCE : THIRTYTWO_BITS ; PROT : SIXTEEN_BITS ; RESULT : RESULT_TYPE; when FROM_TCP => DEST : THIRTYTWO_BITS ; TOS, TTL, LEN, ID, DF : SIXTEEN_BITS ; OPTIONS : OPTION_TYPE ; SRC : THIRTYTWO_BITS ; when DATA_FROM_SUBNET => BYTE_COUNT : SIXTEEN_BITS ; when NO_IP_ACTION => null; end case; end record; end IP_GLOBALS; --:::::::::::::: --ulp_vmodulo_.ada --:::::::::::::: ----------------------------------------------------------------------- -- -- DoD Protocols NA-00002-200 80-01040-100(-) -- E-Systems, Inc. August 07, 1985 -- -- ULP_VMODULO_.ADA Author : Jim Baldo -- ----------------------------------------------------------------------- with BUFFER_DATA ; use BUFFER_DATA ; package MODULO is type MODULAR is record HI, LOW : THIRTYTWO_BITS ; end record; function "<" (X,Y: MODULAR) return BOOLEAN; function "<=" (X,Y: MODULAR) return BOOLEAN; function ">" (X,Y: MODULAR) return BOOLEAN; function ">=" (X,Y : MODULAR) return BOOLEAN; function "+" (X,Y: MODULAR) return MODULAR; function "+" (X: MODULAR;Y : THIRTYTWO_BITS ) return MODULAR; function "+" ( X : THIRTYTWO_BITS ; Y : MODULAR) return MODULAR; function "+" (X : MODULAR; Y : SIXTEEN_BITS ) return MODULAR; function "+" ( X : SIXTEEN_BITS ; Y : MODULAR) return MODULAR; function "-" ( X : MODULAR; Y : SIXTEEN_BITS ) return MODULAR; function "-" (X,Y: MODULAR) return MODULAR; function LONG(X : MODULAR) return THIRTYTWO_BITS ; function MODULAR_CONVERT (X : SIXTEEN_BITS ) return MODULAR; function MODULAR_CONVERT (X : THIRTYTWO_BITS ) return MODULAR; function GET_MODULAR(PP:STRING) return MODULAR; procedure PUT_MODULAR(PP : MODULAR); end MODULO; --:::::::::::::: --ulp_vmodulo.ada --:::::::::::::: ----------------------------------------------------------------------- -- -- DoD Protocols NA-00002-200 80-01041-100(-) -- E-Systems, Inc. August 07, 1985 -- -- ULP_VMODULO.ADA Author : Jim Baldo -- ----------------------------------------------------------------------- with TEXT_IO; use TEXT_IO; package body MODULO is package INT_IO is new INTEGER_IO( THIRTYTWO_BITS ); function LONG(X : MODULAR) return THIRTYTWO_BITS is begin return X.HI+X.LOW ; -- DOES NOT WORK ALL THE TIME! MAY RAISE NUMERIC ERROR end LONG; function MODULAR_CONVERT (X : SIXTEEN_BITS ) return MODULAR is Y : MODULAR ; begin Y.HI := 0 ; Y.LOW := THIRTYTWO_BITS (X); return Y; exception when CONSTRAINT_ERROR => -- PUT_LINE("CONSTRAINT ERROR IN INT MODULAR_CONVERT"); raise; when others => -- PUT_LINE("ERROR IN INT MODULAR_CONVERT"); raise; end; function MODULAR_CONVERT (X : THIRTYTWO_BITS ) return MODULAR is Y : MODULAR; begin Y.HI := X / 2**16 ; Y.LOW := X MOD 2**16 ; return Y; exception when CONSTRAINT_ERROR => -- PUT_LINE("CONSTRAINT ERROR IN LONG_INT MODULAR_CONVERT"); raise; when others => -- PUT_LINE("ERROR IN LONG_INT MODULAR_CONVERT"); raise; end; procedure PUT_MODULAR(PP : MODULAR) is begin TEXT_IO.PUT("THE ANSWER IS "); IF PP.HI <= 2**15-1 THEN INT_IO.PUT((PP.HI * (2**16)) + PP.LOW) ; TEXT_IO.PUT_LINE(""); ELSE TEXT_IO.PUT(" negative ") ; INT_IO.PUT(PP.HI) ; TEXT_IO.PUT(","); INT_IO.PUT(PP.LOW) ; TEXT_IO.PUT_LINE("") ; END IF ; end; function GET_MODULAR(PP:STRING) return MODULAR is X : MODULAR ; begin -- TEXT_IO.PUT_LINE(PP); -- TEXT_IO.PUT_LINE(""); -- return VAL; X.HI := 0 ; X.LOW := 0 ; RETURN(X) ; end; function "+" (X : SIXTEEN_BITS ; Y : MODULAR) return MODULAR is begin RETURN(MODULAR_CONVERT(X) + Y) ; end; function "+" ( X : MODULAR; Y : SIXTEEN_BITS ) return MODULAR is begin RETURN(MODULAR_CONVERT(Y) + X) ; end; function "+" ( X : THIRTYTWO_BITS ; Y : MODULAR) return MODULAR is begin RETURN(MODULAR_CONVERT(X) + Y) ; end; function "+" (X : MODULAR;Y : THIRTYTWO_BITS ) return MODULAR is begin RETURN(MODULAR_CONVERT(Y) + X) ; end; function "+" (X,Y: MODULAR) return MODULAR is Z : MODULAR; CARRY : INTEGER := 0 ; begin Z.LOW := X.LOW + Y.LOW; IF Z.LOW >= 2**16 THEN -- CARRY Z.LOW := Z.LOW - 2**16 ; CARRY := 1 ; END IF ; Z.HI := (Y.HI + X.HI + CARRY) MOD 2**16 ; return Z; end; function "<=" (X,Y : MODULAR) return BOOLEAN is begin if X.HI = Y.HI then RETURN X.LOW <= Y.LOW ; elsif (X.HI - Y.HI) > 2**15 then -- we wrapped around if X.HI > Y.HI then -- Y wrapped around return (TRUE) ; else return (FALSE) ; end if ; else return (X.HI <= Y.HI) ; end if ; end; function ">=" (X,Y : MODULAR) return BOOLEAN is begin if X.HI = Y.HI then RETURN X.LOW >= Y.LOW ; elsif (X.HI - Y.HI) > 2**15 then -- we wrapped around if X.HI < Y.HI then -- Y wrapped around return (TRUE) ; else return (FALSE) ; end if ; else return (X.HI >= Y.HI) ; end if ; end; function "<" (X,Y : MODULAR) return BOOLEAN is begin return(not (X >= Y)) ; end; function ">" (X,Y : MODULAR) return BOOLEAN is begin return(not (X <= Y)) ; end; function "-" ( X : MODULAR; Y : SIXTEEN_BITS ) return MODULAR is begin return(X - MODULAR_CONVERT(Y)) ; end; function "-" (X, Y : MODULAR) return MODULAR is Z : MODULAR ; BORROW : INTEGER := 0 ; begin Z.LOW := X.LOW - Y.LOW ; if Z.LOW < 0 then Z.LOW := Z.LOW + 2**16 ; -- BORROW BORROW := 1 ; end if ; Z.HI := (X.HI - Y.HI - BORROW) ; IF Z.HI < 0 THEN Z.HI := 2**16 - ABS(Z.HI) ; END IF ; RETURN (Z) ; end; end MODULO; --:::::::::::::: --ulp_tcpglbdat_.ada --:::::::::::::: ----------------------------------------------------------------------- -- -- DoD Protocols NA-00002-200 80-01039-100(-) -- E-Systems, Inc. August 07, 1985 -- -- ULP_TCPGLBDAT_.ADA Author : Jim Baldo -- ----------------------------------------------------------------------- with STARLET ; use STARLET ; with MODULO; use MODULO; with IP_GLOBALS; use IP_GLOBALS; with BUFFER_DATA; use BUFFER_DATA; package T_TCP_GLOBALS_DATA_STRUCTURES is ----------------------------------------------------------- --This implementation is for use with the DEC/Ada -- --compiler . -- ----------------------------------------------------------- --***************************************************************************** --*Implementation Restrictions * --*--------------------------- * --* Some of these types could have their bit size set when the compiler * --* is able to do it. * --***************************************************************************** TABLE_RANGE : constant SIXTEEN_BITS := 32; subtype ERROR_TYPE is SIXTEEN_BITS ; type STATUS_TYPE is (CONNECTION_OPEN, CONNECTION_CLOSED, OPENING, CLOSING); type ACKPASS is (PASSIVE, ACTIVE); type TIMER_TYPE is (TIME_WAIT_TIMER, RETRANS_TIMER, TIMEOUT_TIMER); type HEADER_TYPE is (ACK, SYN, SYN_ACK, SEGMENT, SEG_ACK, FIN, RST, RST_ACK); type STATES is (CLOSED,SYN_SENT,SYN_RECEIVED,ESTABLISHED,LISTEN, FIN_WAIT_1,CLOSE_WAIT,FIN_WAIT_2,CLOSING,TIME_WAIT,LAST_ACK); type SECURE is array(1..9) of SIXTEEN_BITS ; -- EACH ELEMENT OF THIS ARRAY IS ONE -- OCTET OF SECURITY OPTION INFO. AFTER -- THE TYPE AN LENGTH FIELD. type TABLE_TYPE is array(1..TABLE_RANGE) of SIXTEEN_BITS ; type TIME_ACTION is (NONE, RETRANSMIT_TIMEOUT, CONNECTION_TIMEOUT, TIME_WAIT_TIMEOUT); subtype WND_PORT is SIXTEEN_BITS ; -- THE ACTUAL RANGE IS + OR - 2**16-1 subtype SEVEN_BITS is SIXTEEN_BITS ; subtype TEN_BITS is SIXTEEN_BITS ; subtype TWO_BITS is INTEGER; subtype FOUR_OCTETS is THIRTYTWO_BITS ; subtype TWO_OCTETS is SIXTEEN_BITS ; subtype ONE_OCTET is SIXTEEN_BITS ; subtype HALF_OCTET is SIXTEEN_BITS ; subtype SIX_BITS is SIXTEEN_BITS ; subtype ONE_BIT is SIXTEEN_BITS ; type BUFFER_POINTER is record BTYPE : SIXTEEN_BITS ; DATA_LEN : SIXTEEN_BITS := 0; SOURCE_PORT : TWO_OCTETS; DESTINATION_PORT : TWO_OCTETS; SEQ_NUM : MODULAR; ACK_NUM : MODULAR; DATA_OFFSET : HALF_OCTET; RESERVED : SIX_BITS; URG_FLAG : ONE_BIT; ACK : ONE_BIT; PUSH_FLAG : ONE_BIT; RST : ONE_BIT; SYN : ONE_BIT; FIN : ONE_BIT; WINDOW : TWO_OCTETS; TCP_CSUM : TWO_OCTETS; URG_PTR : TWO_OCTETS; --OPTIONS FOR TCP TCP_OPTIONS : OPTION_TYPE := (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0); DATA : BUFFER_AREA; -- ARRAY OF SYSTEM.BYTES. FROM USER LEVEL. end record; ERROR_TABLE_CLEAR : constant TABLE_TYPE := (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0); --*********************QUEUE TYPES****************************** type QNAME is (TRANSMIT_QUEUE, TCP_RETRANSMIT_QUEUE, TCP_RECEIVED_SEGMENT_QUEUE, RECEIVE_QUEUE, PROCESSED_SEGMENTS_FOR_USER_QUEUE); type STD_Q_ITEM is record BUFFER : PACKED_BUFFER_PTR; UNPACKED_BUFFER : BUFFER_POINTER; LENGTH : SIXTEEN_BITS ; end record; type STD_QUEUE_ELEMENT; type STD_QUEUE_ELEMENT_POINTER is access STD_QUEUE_ELEMENT; type STD_QUEUE_ELEMENT is record ELEMENT : STD_Q_ITEM; TIME : THIRTYTWO_BITS ; -- FOR THE RETRANSMISSION TIME. IP_ID : SIXTEEN_BITS ; -- THE IP ID FOR RETRANSMISSION NEXT : STD_QUEUE_ELEMENT_POINTER; end record; type STD_HEAD_PTR is record ELEMENT_COUNT : SIXTEEN_BITS ; FIRST_ELEMENT : STD_QUEUE_ELEMENT_POINTER; LAST_ELEMENT : STD_QUEUE_ELEMENT_POINTER; end record; type STD_QUEUE_HEAD_POINTERS is array(QNAME) of STD_HEAD_PTR; --*********************QUEUE TYPES****************************** NUMBER_OF_QUEUES : constant SIXTEEN_BITS := 5; MAX_QUEUE_SIZE : constant SIXTEEN_BITS := 32; INITIAL_QUEUE_HEADER : STD_HEAD_PTR := (0, NULL, NULL); INITIAL_QUEUE_HEADER_POINTERS : STD_QUEUE_HEAD_POINTERS := (INITIAL_QUEUE_HEADER, INITIAL_QUEUE_HEADER, INITIAL_QUEUE_HEADER, INITIAL_QUEUE_HEADER, INITIAL_QUEUE_HEADER); type TRANSMISSION_CONTROL_BLOCK; type TCB_PTR is access TRANSMISSION_CONTROL_BLOCK; type TRANSMISSION_CONTROL_BLOCK is record TCP_CHANNEL_NAME : STRING(1..30) ; TCP_CHANNEL_PTR : CHANNEL_TYPE ; STATE : STATES; CONNECTION_STATUS : STATUS_TYPE; LOCAL_PORT : SIXTEEN_BITS := -1; LOCAL_NET : SIXTEEN_BITS := 0;--TEMPORARY** LOCAL_HOST : SIXTEEN_BITS := 1;-- TEMPORARY** SOURCE_ADDRESS : THIRTYTWO_BITS := 1;-- TEMPORARY** DESTINATION_ADDRESS : THIRTYTWO_BITS ; FOREIGN_PORT : SIXTEEN_BITS := -1; FOREIGN_HOST : THIRTYTWO_BITS := -1; FOREIGN_NET : THIRTYTWO_BITS := -1; SND_UNA : MODULAR; SND_UP : MODULAR; SND_NXT : MODULAR; SND_WND : SIXTEEN_BITS := 190; RCV_NXT : MODULAR; PRECEDENCE : SIXTEEN_BITS := 0; USER_NOTIFICATION : BOOLEAN := FALSE; SECURITY : SECURE := (0, 0, 0, 0, 0, 0, 0, 0, 0); -- SOURCE_PORT : SIXTEEN_BITS ; -- LIMITED BITS AND RANGE IS YET TO BE DET -- ERMINED BUFFSIZE : SIXTEEN_BITS ; RCV_BUFFER_SIZE : WND_PORT; RCV_URGENT_POINTER : SIXTEEN_BITS ; SND_WL1 : MODULAR; -- SEQ NUM OF THE LAST SEGMENT --USED TO UPDATE SND.WND SND_WL2 : MODULAR;-- RECORDS THE ACK NUM OF THE --LAST SEGMENT USED TO -- UPDATE SND.WND. THIS VARIABLE AND THE ABOVE ONE -- PREVENT AN OLD SEGMENT FROM BEING USED TO UPDATE -- THE WINDOW. RCV_WINDOW : WND_PORT := 190; INIT_RCV_SEQ_NUM : MODULAR; ISS : MODULAR;-- THE INITIAL SEND SEQUENCE NUMBER (ISS) RETRANS_INTERVAL : SIXTEEN_BITS := 30; -- LAST ARE PROBABLY TEMPORARY MAX_RETRY_OF_PACKET : SIXTEEN_BITS RANGE 0..8; PROTOCOL : SIXTEEN_BITS := 0; --(PTCL) UNKNOWN VALUE FOR TCP*** ACTIVE_PASSIVE : ACKPASS; CLOSE_PENDING : BOOLEAN := FALSE; -- FOR A CLOSE WITH DATA TO SEND. ERROR_TABLE : TABLE_TYPE := ERROR_TABLE_CLEAR; QHEADS : STD_QUEUE_HEAD_POINTERS := INITIAL_QUEUE_HEADER_POINTERS; IDENT : SIXTEEN_BITS := -1; -- THE IDENTIFICATION NUMBER FOR AN IP DATAGRAM RETRANS_IDENT : SIXTEEN_BITS ; -- SUPPLIED BY THE QUEUE RETRANS ROUTINE FOR IP. NEXT_CONNECTION_TIMEOUT : THIRTYTWO_BITS ; NEXT_TIME_WAIT_TIMEOUT : THIRTYTWO_BITS ; CONNECTION_TIMEOUT : SIXTEEN_BITS := 180; -- DEFAULT IS 180 SECONDS OR 3 MINUTES CLOSE_OK_NOTIFICATION : BOOLEAN := FALSE; NEXT : TCB_PTR; end record; -- THE PSEUDO HEADER SOURCE, DESTINATION : THIRTYTWO_BITS ; PROTOCOL, IP_TOS : SIXTEEN_BITS ; -- THE SECURITY OPTION FROM IP SECURITY : SECURE; SECURE_CLEAR : SECURE := (0, 0, 0, 0, 0, 0, 0, 0, 0); MAX_PORTS : constant SIXTEEN_BITS := 4; type PORT_LIST is array(1..MAX_PORTS) of SIXTEEN_BITS ; VALID_PORT_LIST : PORT_LIST := ( 20, 21, 23, 25); LEN, IDENT : SIXTEEN_BITS ; LCN_TCB_STATE : STATES; TYPE_FLAG : HEADER_TYPE; RESERVE : TCB_PTR; BIT_SET : constant SIXTEEN_BITS := 1; LCN : TCB_PTR; -- THE GLOBAL LOCAL CONNECTION NAME OPTIONS : OPTION_TYPE; -- THESE DECLARATIONS ARE CONSTANT IP PARAMETERS. ONE_MINUTE : constant SIXTEEN_BITS := 60; -- 00111100 TOS : constant SIXTEEN_BITS := 0; -- THE VALUE FROM TCP SPEC FOR THE IP AS THE LOWER -- LEVEL PROTOCOL. TTL : constant SIXTEEN_BITS := ONE_MINUTE; DONT_FRAGMENT : constant SIXTEEN_BITS := 1; -- WE ARE NOT A GATEWAY. CLEAR : OPTION_TYPE := (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0); TCP_SECURITY_OPTIONS : OPTION_TYPE := (130,11,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0); end T_TCP_GLOBALS_DATA_STRUCTURES; --:::::::::::::: --new_ncommu_.ada --:::::::::::::: ----------------------------------------------------------------------- -- -- DoD Protocols NA-00002-200 80-01037-100(-) -- E-Systems, Inc. August 07, 1985 -- -- NEW_NCOMMU_.ADA Author : Jim Baldo -- ----------------------------------------------------------------------- with STARLET; use STARLET; with IP_GLOBALS; use IP_GLOBALS; with BUFFER_DATA; use BUFFER_DATA; with T_TCP_GLOBALS_DATA_STRUCTURES; use T_TCP_GLOBALS_DATA_STRUCTURES; package WITH_ULP_COMMUNICATE is --------------------------------------------------------------- --This implementation is for use with DEC/Ada compiler. -- --------------------------------------------------------------- ------------------------------------------------------------------------------- --This package contains all the data abstractions and operations necessary -- --to support the User/TCP interface and TCP/lower-level interface. -- --The enumerated type ACTION represents the type of request primitive -- --that is sent by the upper layer or lower layer protocols. -- ------------------------------------------------------------------------------- type STATUS_TYPE is ( CONNECTION_OPEN, CONNECTION_CLOSED, OPENING, CLOSING); type SECURITIES is array(1..9) of SIXTEEN_BITS ; type STATE_TYPE is ( CLOSED, SYN_SENT, SYN_RECEIVED, ESTABLISHED, LISTEN, FIN_WAIT_1, CLOSE_WAIT, FIN_WAIT_2, CLOSING, TIME_WAIT, LAST_ACK); -- same as in TCPGLB type STATUS_RECORD is record SOURCE_PORT : SIXTEEN_BITS ; SOURCE_ADDRESS : THIRTYTWO_BITS ; DESTINATION_PORT : SIXTEEN_BITS ; DESTINATION_ADDRESS : THIRTYTWO_BITS ; CONNECTION_STATE : STATE_TYPE; STATUS : STATUS_TYPE; LOCAL_RCV_WINDOW : SIXTEEN_BITS ; REMOTE_RCV_WINDOW : SIXTEEN_BITS ; OCTETS_ON_RETRANSMIT_QUEUE : SIXTEEN_BITS ; DATA_WAITING_FOR_ULP : SIXTEEN_BITS ; URGENT_STATE : BOOLEAN; PRECEDENCE : SIXTEEN_BITS ; SECURITY : SECURITIES; ULP_TIMEOUT : SIXTEEN_BITS ; end record; subtype LCN_TYPE is TCB_PTR; type LCN_PTR_TYPE is record LCN_PTR : LCN_TYPE := null; CHANNEL_PTR : CHANNEL_TYPE ; CHANNEL_NAME : STRING(1..30) ; end record; ------------------------------------------------------------------------------- -- THE MESSAGE NUMBERS FOR THE USER AND THEIR MEANING FOLLOW -- -- -1 : NO USER ACTION -- -- -- -- 2: CONNECTION ILLEGAL -- -- 3: CONNECTION DOES NOT EXIST -- -- 4: FOREIGN SOCKET UNSPECIFIED -- -- 5: INSUFFICIENT RESOURCES -- -- 6: CONNECTION CLOSING -- -- 7: URGENT DATA -- -- 8: OK ON ABORT -- -- 9: PRECEDENCE NOT ALLOWED -- -- 10: BUFFER FOR USER -- -- 11: SECURITY/COMPARTMENT ILLEGAL -- -- 12: CONNECTION EXISTS -- -- 14: RETURN LCN -- -- 15: TCB POINTER AND STATE -- -- 16: CONNECTION RESET -- -- 17: CONNECTION REFUSED -- -- 18: OK ON CLOSE -- -- 19: PUSHED BUFFER FOR USER -- -- 20: OUT OF BUFFERS -- -- 21: COULDN'T DO RESET -- -- 22: IP OVERLOADED. -- -- 23: CONNECTION IS NOW OPEN. -- ------------------------------------------------------------------------------- type USER_MESSAGE(MESSAGE_NUMBER : SIXTEEN_BITS := 0) is record LOCAL_CONNECTION_NAME : LCN_PTR_TYPE; case MESSAGE_NUMBER is when 10 | 19 => DATA_BUFFER : PACKED_BUFFER_PTR; when 15 => -- STATUS PARAMETERS STATUS_PARAMS : STATUS_RECORD; when others => null; end case; end record; type ACTION is (OPEN,SEND,RECEIVE,ABOR_T,CLOSE,STATUS,DATA_FROM_IP, TIMER_TIMEOUT, ERROR_MESSAGE, TIMEOUT_IN_RETRANS_QUEUE, TIMEOUT_IN_TIME_WAIT, NO_TCP_ACTION); subtype SECURITY_OPTION_ARRAY is SIXTEEN_BITS range 1..9; type SECURITY_OPTION_TYPE is array( SECURITY_OPTION_ARRAY ) of SIXTEEN_BITS ; -- EACH ELEMENT CONTAINS AN -- OCTET OF SECURITY DATA. type TCP_OPTION_TYPE is array(1..50) of SIXTEEN_BITS ; type ACKPASS is (PASSIVE, ACTIVE); type TIMER_PARAMS is record MESSAGE_NUMBER : SIXTEEN_BITS ; end record; type TIME_WAIT_PARAMS is record LOCAL_CONNECTION_NAME : LCN_PTR_TYPE; end record; type OPEN_PARAMS is record LOCAL_PORT, FOREIGN_PORT : SIXTEEN_BITS ; FOREIGN_NET_HOST : THIRTYTWO_BITS ; ACTIVE_PASSIVE : ACKPASS; BUFFER_SIZE, TIMEOUT : SIXTEEN_BITS ; LOCAL_CONNECTION_NAME : LCN_PTR_TYPE; SECURITY, PRECEDENCE : SIXTEEN_BITS ; OPTIONS : TCP_OPTION_TYPE; end record; type STATUS_PARAMS is record LOCAL_CONNECTION_NAME : LCN_PTR_TYPE; end record; type ERROR_PARAMS is record ERROR_INDICATOR : SIXTEEN_BITS ; -- THIS MAY CHANGE. end record; type RETRANS_PARAMS is record QUEUE_NUM : SIXTEEN_BITS ; end record; type SEG_ARRIVE_PARAMS is record BUFPTR : PACKED_BUFFER_PTR; BYTE_COUNT : SIXTEEN_BITS ; SOURCE_ADDRESS, DESTINATION_ADDRESS : THIRTYTWO_BITS ; PROTOCOL : SIXTEEN_BITS ; TOS : SIXTEEN_BITS ; SECURITY : SECURITY_OPTION_TYPE; end record; type SEND_PARAMS is record LOCAL_CONNECTION_NAME : LCN_PTR_TYPE; BUFPTR : PACKED_BUFFER_PTR; BYTE_COUNT, PUSH_FLAG, URG_FLAG, TIMEOUT : SIXTEEN_BITS ; end record; type RECEIVE_PARAMS is record LOCAL_CONNECTION_NAME : LCN_PTR_TYPE; BUFPTR : PACKED_BUFFER_PTR; BYTE_COUNT : SIXTEEN_BITS ; end record; type ABORT_CLOSE_PARAMS is record LOCAL_CONNECTION_NAME : LCN_PTR_TYPE; end record; --TCP responds to message which are associated with a type of event. The --data abstraction of MESSAGE creates the appropiate message for the given --event. type MESSAGE(EVENT : ACTION := OPEN) is record case EVENT is when ABOR_T | CLOSE => ABORT_CLOSE_PARAMETERS : ABORT_CLOSE_PARAMS; when DATA_FROM_IP => DATA_FROM_IP_PARAMETERS : SEG_ARRIVE_PARAMS; when RECEIVE => RECEIVE_PARAMETERS : RECEIVE_PARAMS; when SEND => SEND_PARAMETERS : SEND_PARAMS; when OPEN => OPEN_PARAMETERS : OPEN_PARAMS; when STATUS => STATUS_PARAMETERS : STATUS_PARAMS; when TIMEOUT_IN_TIME_WAIT => TIME_WAIT_PARAMETERS : TIME_WAIT_PARAMS; when TIMEOUT_IN_RETRANS_QUEUE => RETRANS_PARAMETERS : RETRANS_PARAMS; when ERROR_MESSAGE => ERROR_PARAMETERS : ERROR_PARAMS; when TIMER_TIMEOUT => TIMER_PARAMETERS : TIMER_PARAMS; when NO_TCP_ACTION => NULL; end case; end record; procedure WAIT_FOR_TCP_MESSAGE(USER_MESS : in out USER_MESSAGE); --This procedure obtains a message in a queue for the ULP from TCP. procedure MESSAGE_FOR_TCP( TCP_MESSAGE : in out MESSAGE; REQUEST_OK : out BOOLEAN ) ; --This procedure is used by ULP to put a message for TCP. end WITH_ULP_COMMUNICATE; --:::::::::::::: --new_ncommu.ada --:::::::::::::: ----------------------------------------------------------------------- -- -- DoD Protocols NA-00002-200 80-01038-100(-) -- E-Systems, Inc. August 07, 1985 -- -- NEW_NCOMMU.ADA Author : Jim Baldo -- ----------------------------------------------------------------------- with CONDITION_HANDLING ; use CONDITION_HANDLING ; with UNCHECKED_CONVERSION ; with TEXT_IO ; use TEXT_IO; with TASKING_SERVICES ; use TASKING_SERVICES ; with SYSTEM ; use SYSTEM ; package body WITH_ULP_COMMUNICATE is package CONVERT_INT_16_TO_STRING is new INTEGER_IO( SIXTEEN_BITS ) ; package CONVERT_INT_32_TO_STRING is new INTEGER_IO( THIRTYTWO_BITS ) ; MBX_STATUS : COND_VALUE_TYPE ; TO_TCP_CHANNEL : CHANNEL_TYPE ; XMESSAGE : MESSAGE; type XUSER_MESSAGE_TYPE is record THE_USER_MESSAGE : USER_MESSAGE ; THE_BUFFER : PACKED_BUFFER ; THE_STATUS_PARAMS : STATUS_RECORD ; end record ; type XMESSAGE_TYPE is record THE_TCP_MESSAGE : MESSAGE ; THE_BUFFER : PACKED_BUFFER ; end record ; function PHYSICAL_ADDRESS is new UNCHECKED_CONVERSION ( ADDRESS, UNSIGNED_LONGWORD ) ; procedure WAIT_FOR_TCP_MESSAGE(USER_MESS : in out USER_MESSAGE) is XUSER_MESSAGE : XUSER_MESSAGE_TYPE ; BUFFER : PACKED_BUFFER_PTR ; begin TASK_QIOW ( STATUS => MBX_STATUS , CHAN => USER_MESS.LOCAL_CONNECTION_NAME.CHANNEL_PTR , FUNC => IO_READVBLK , P1 => PHYSICAL_ADDRESS ( XUSER_MESSAGE'ADDRESS ) , P2 => UNSIGNED_LONGWORD (XUSER_MESSAGE'SIZE/8 ) ) ; USER_MESS := XUSER_MESSAGE.THE_USER_MESSAGE ; case USER_MESS.MESSAGE_NUMBER is when 10 | 19 => BUFFGET( BUFFER, 1); USER_MESS.DATA_BUFFER := BUFFER ; USER_MESS.DATA_BUFFER.ALL := XUSER_MESSAGE.THE_BUFFER ; when 15 => USER_MESS.STATUS_PARAMS := XUSER_MESSAGE.THE_STATUS_PARAMS ; when 8 | 16 | 18 | 24 => --connection closed: aborted; reset; --connection timeout; delete mailbox DELMBX( STATUS => MBX_STATUS , CHAN => USER_MESS.LOCAL_CONNECTION_NAME.CHANNEL_PTR ) ; when others => null ; end case ; end WAIT_FOR_TCP_MESSAGE; procedure MESSAGE_FOR_TCP( TCP_MESSAGE : in out MESSAGE; REQUEST_OK : out BOOLEAN) is CHANNEL : CHANNEL_TYPE ; FOREIGN_NET_HOST : STRING(1..5) ; FOREIGN_PORT : STRING(1..5) ; LOCAL_NET_HOST : STRING(1..5) ; LOCAL_PORT : STRING(1..5) ; CHANNEL_NAME : STRING(1..30) ; XTCP_MESSAGE : XMESSAGE_TYPE ; begin if TCP_MESSAGE.EVENT = OPEN then -- Create a mailbox CHANNEL_NAME := " " ; FOREIGN_NET_HOST := " " ; FOREIGN_PORT := " " ; LOCAL_NET_HOST := " " ; LOCAL_PORT := " " ; CONVERT_INT_32_TO_STRING.PUT ( FOREIGN_NET_HOST , TCP_MESSAGE.OPEN_PARAMETERS. FOREIGN_NET_HOST ) ; CONVERT_INT_16_TO_STRING.PUT ( FOREIGN_PORT , TCP_MESSAGE.OPEN_PARAMETERS. FOREIGN_PORT ) ; CONVERT_INT_32_TO_STRING.PUT ( LOCAL_NET_HOST , WHOIAM ) ; CONVERT_INT_16_TO_STRING.PUT ( LOCAL_PORT , TCP_MESSAGE.OPEN_PARAMETERS. LOCAL_PORT ) ; CHANNEL_NAME(1..3) := "MBX"; CHANNEL_NAME(4..8) := FOREIGN_NET_HOST ; CHANNEL_NAME(9..13) := FOREIGN_PORT ; CHANNEL_NAME(14..18) := LOCAL_NET_HOST ; CHANNEL_NAME(19..23) := LOCAL_PORT ; CREMBX( STATUS => MBX_STATUS , PRMFLG => true , -- permanent CHAN => CHANNEL , MAXMSG => XUSER_MESSAGE_TYPE'SIZE/8, --size of message BUFQUO => 10 * XUSER_MESSAGE_TYPE'SIZE/8, --size of queue LOGNAM => CHANNEL_NAME ) ; if NOT SUCCESS(MBX_STATUS) then PUT_LINE("Could not create tcp channel") ; else TCP_MESSAGE.OPEN_PARAMETERS.LOCAL_CONNECTION_NAME.CHANNEL_PTR := CHANNEL ; TCP_MESSAGE.OPEN_PARAMETERS.LOCAL_CONNECTION_NAME.CHANNEL_NAME := CHANNEL_NAME; XTCP_MESSAGE.THE_TCP_MESSAGE := TCP_MESSAGE ; TASK_QIOW ( STATUS => MBX_STATUS, CHAN => TO_TCP_CHANNEL , FUNC => IO_WRITEVBLK + IO_M_NOW, P1 => PHYSICAL_ADDRESS (XTCP_MESSAGE'ADDRESS), P2 => UNSIGNED_LONGWORD (XTCP_MESSAGE'SIZE/8 ) ); end if; else XTCP_MESSAGE.THE_TCP_MESSAGE := TCP_MESSAGE ; if TCP_MESSAGE.EVENT = SEND then XTCP_MESSAGE.THE_BUFFER := TCP_MESSAGE.SEND_PARAMETERS.BUFPTR.ALL ; BUFFREE( TCP_MESSAGE.SEND_PARAMETERS.BUFPTR, 0); elsif TCP_MESSAGE.EVENT = RECEIVE then BUFFREE( TCP_MESSAGE.RECEIVE_PARAMETERS.BUFPTR, 1); end if ; TASK_QIOW ( STATUS => MBX_STATUS, CHAN => TO_TCP_CHANNEL , FUNC => IO_WRITEVBLK + IO_M_NOW, P1 => PHYSICAL_ADDRESS (XTCP_MESSAGE'ADDRESS), P2 => UNSIGNED_LONGWORD (XTCP_MESSAGE'SIZE/8 ) ); end if ; REQUEST_OK := SUCCESS (MBX_STATUS) ; EXCEPTION WHEN OTHERS => PUT_LINE("EXCEPTION IN MESSAGE_FOR_TCP") ; end MESSAGE_FOR_TCP; begin CREMBX( STATUS => MBX_STATUS , PRMFLG => true , -- permanent CHAN => TO_TCP_CHANNEL, MAXMSG => XMESSAGE'SIZE, --size of message BUFQUO => 10 * XMESSAGE'SIZE , --size of queue LOGNAM => "TO_TCP_CHANNEL") ; -- fixed name if NOT SUCCESS(MBX_STATUS) then PUT_LINE("Could not assign tcp channel") ; end if ; END WITH_ULP_COMMUNICATE;