[OpenSPARC-T2-SAM] / obp / obp / pkg / netinet / tcp-reqs.fth

\ ========== Copyright Header Begin ==========================================
\ 
\ Hypervisor Software File: tcp-reqs.fth
\ 
\ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
\ 
\  - Do no alter or remove copyright notices
\ 
\  - Redistribution and use of this software in source and binary forms, with 
\    or without modification, are permitted provided that the following 
\    conditions are met: 
\ 
\  - Redistribution of source code must retain the above copyright notice, 
\    this list of conditions and the following disclaimer.
\ 
\  - Redistribution in binary form must reproduce the above copyright notice,
\    this list of conditions and the following disclaimer in the
\    documentation and/or other materials provided with the distribution. 
\ 
\    Neither the name of Sun Microsystems, Inc. or the names of contributors 
\ may be used to endorse or promote products derived from this software 
\ without specific prior written permission. 
\ 
\     This software is provided "AS IS," without a warranty of any kind. 
\ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES, 
\ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A 
\ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN 
\ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR 
\ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR 
\ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN 
\ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR 
\ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE 
\ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY, 
\ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF 
\ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
\ 
\ You acknowledge that this software is not designed, licensed or
\ intended for use in the design, construction, operation or maintenance of
\ any nuclear facility. 
\ 
\ ========== Copyright Header End ============================================
id: @(#)tcp-reqs.fth 1.1 04/09/07
purpose: TCP socket interface
copyright: Copyright 2004 Sun Microsystems, Inc.  All Rights Reserved
copyright: Use is subject to license terms.

headerless

0  value  tcp-last-port#	\ Last TCP port number assigned

: tcp-next-port ( -- port# )
   tcp-last-port# 1+  dup d# 32768 d# 65535 between  0= if
      drop d# 32768
   then  dup to tcp-last-port#
;

\ Allocate/initialize protocol control blocks and link structures together. 
: tcp-soattach ( sockaddr -- )
   tcp-inpcb-list inpcb-alloc			( sockaddr inpcb )
   tcb-alloc					( sockaddr inpcb tcb )
   2dup >tcb-inpcb !  over >in-ppcb !		( sockaddr inpcb )
   2dup >in-socket !  swap >so-inpcb !		( )
;

\ Close connection and deallocate Internet PCB and TCP control blocks. 
: tcp-sodetach ( sockaddr -- )
   dup so>tcb 0 TR_SOCKET PRREQ_DETACH tcp-trace	( sockaddr )
   dup so>tcb dup tcp-close-connection			( sockaddr tcb )
   dup tcb>inpcb  swap tcb-free  inpcb-free		( sockaddr )
   0 swap >so-inpcb !					( )
;

\ Bind local address and port number to socket.
: tcp-sobind ( sockaddr addr addrlen -- )
   drop  insock>addr,port  dup 0=  if		( sockaddr addr port )
      drop tcp-next-port			( sockaddr addr lport )
   then						( sockaddr addr lport )
   rot  so>inpcb  -rot  inpcb-bind  		( )
;

\ Prepare to accept incoming connections. Only one pending connection 
\ is supported.
: tcp-solisten ( sockaddr backlog -- 0 )
   drop  dup so>inpcb  dup in-lport@ 0=  if	( sockaddr inpcb )
      my-ip-addr tcp-next-port inpcb-bind	( sockaddr )
   else						( sockaddr inpcb )
      drop					( sockaddr )
   then						( sockaddr )
   TCPS_LISTEN swap so>tcb tcb-state!		( )
   0						( result )
;

\ Accept a connection and return peer's IP address and port number to 
\ caller. A new socket is not created (i.e, the listening socket is
\ the connected socket).
: tcp-soaccept ( sockaddr addr addrlen -- 0 | error# )
   2 pick so>tcb				( sockaddr addr addrlen tcb )
   tcp-accept-connection ?dup if		( sockaddr addr addrlen error#)
      >r  3drop r>				( error# )
   else						( sockaddr addr addrlen )
      /insock swap l!				( sockaddr addr )
      >r so>inpcb r> in-getpeeraddr  0		( 0 )
   then						( 0 | error# )
;

\ Initiate connection to peer.
: tcp-soconnect ( sockaddr srvaddr addrlen -- 0 | error# )
   drop  over so>inpcb swap			( sockaddr inpcb addr )
   over in-lport@ 0=  if			( sockaddr inpcb addr )
      over my-ip-addr tcp-next-port inpcb-bind	( sockaddr inpcb addr )
   then						( sockaddr inpcb addr )
   insock>addr,port inpcb-connect		( sockaddr )
   so>tcb tcp-open-connection			( result )
;

\ Queue data in send buffer and send all the data we can.
: tcp-sosend ( sockaddr buf nbytes flags -- #sent | error# )
   drop  rot  so>tcb  -rot			( tcb buf nbytes )
   2 pick 0 TR_SOCKET PRREQ_SEND tcp-trace	( tcb buf nbytes )
   begin					( tcb buf nbytes )
      2 pick over tcp-canputdata?		( tcb buf nbytes flag )
   0=  while					( tcb buf nbytes )
      2 pick tcb-error@  ?dup  if		( tcb buf nbytes error# )
         >r 3drop r> exit			( error# )
      then					( tcb buf nbytes )
      tcp-poll					( tcb buf nbytes )
   repeat					( tcb buf nbytes )
   2 pick >r  tcp-putdata  r> tcp-output        ( #sent )
;

\ Read data from the receive buffer. Data in the receive buffer can be 
\ read if we have enough data, or we are not expecting any more data, 
\ or if data is being pushed. 
: tcp-soreceive ( sockaddr buf nbytes flags -- #rcvd | error# )
   drop  rot  so>tcb  -rot			( tcb buf nbytes )
   begin					( tcb buf nbytes )
      2 pick over tcp-cangetdata?		( tcb buf nbytes flag )
   0= while					( tcb buf nbytes )
      2 pick tcb-error@  ?dup if		( tcb buf nbytes error# )
         >r 3drop r> exit			( error# )
      then					( tcb buf nbytes )
      tcp-poll					( tcb buf nbytes )
   repeat					( tcb buf nbytes )
   2 pick 0 TR_SOCKET PRREQ_RECV tcp-trace	( tcb buf nbytes )
   tcp-getdata					( #rcvd )
;

\ Process a TCP user request.
: tcp-prreq-execute ( ?? req# -- ?? )
   case
      PRREQ_RECV     of  tcp-soreceive           endof
      PRREQ_SEND     of  tcp-sosend              endof
      PRREQ_ATTACH   of  tcp-soattach            endof
      PRREQ_DETACH   of  tcp-sodetach            endof
      PRREQ_BIND     of  tcp-sobind              endof
      PRREQ_CONNECT  of  tcp-soconnect           endof
      PRREQ_LISTEN   of  tcp-solisten            endof
      PRREQ_ACCEPT   of  tcp-soaccept            endof
      PRREQ_RECVFROM of  3drop 3drop EOPNOTSUPP  endof	\ Not supported
      PRREQ_SENDTO   of  3drop 3drop EOPNOTSUPP  endof	\ Not supported
      ( default ) ." Unknown TCP socket operation"  -1 throw
   endcase
;

headers
Commit	Line	Data
920dae64 AT	1	\ ========== Copyright Header Begin ==========================================
	2	\
	3	\ Hypervisor Software File: tcp-reqs.fth
	4	\
	5	\ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
	6	\
	7	\ - Do no alter or remove copyright notices
	8	\
	9	\ - Redistribution and use of this software in source and binary forms, with
	10	\ or without modification, are permitted provided that the following
	11	\ conditions are met:
	12	\
	13	\ - Redistribution of source code must retain the above copyright notice,
	14	\ this list of conditions and the following disclaimer.
	15	\
	16	\ - Redistribution in binary form must reproduce the above copyright notice,
	17	\ this list of conditions and the following disclaimer in the
	18	\ documentation and/or other materials provided with the distribution.
	19	\
	20	\ Neither the name of Sun Microsystems, Inc. or the names of contributors
	21	\ may be used to endorse or promote products derived from this software
	22	\ without specific prior written permission.
	23	\
	24	\ This software is provided "AS IS," without a warranty of any kind.
	25	\ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES,
	26	\ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A
	27	\ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN
	28	\ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR
	29	\ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR
	30	\ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN
	31	\ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR
	32	\ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE
	33	\ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY,
	34	\ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF
	35	\ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
	36	\
	37	\ You acknowledge that this software is not designed, licensed or
	38	\ intended for use in the design, construction, operation or maintenance of
	39	\ any nuclear facility.
	40	\
	41	\ ========== Copyright Header End ============================================
	42	id: @(#)tcp-reqs.fth 1.1 04/09/07
	43	purpose: TCP socket interface
	44	copyright: Copyright 2004 Sun Microsystems, Inc. All Rights Reserved
	45	copyright: Use is subject to license terms.
	46
	47	headerless
	48
	49	0 value tcp-last-port# \ Last TCP port number assigned
	50
	51	: tcp-next-port ( -- port# )
	52	tcp-last-port# 1+ dup d# 32768 d# 65535 between 0= if
	53	drop d# 32768
	54	then dup to tcp-last-port#
	55	;
	56
	57	\ Allocate/initialize protocol control blocks and link structures together.
	58	: tcp-soattach ( sockaddr -- )
	59	tcp-inpcb-list inpcb-alloc ( sockaddr inpcb )
	60	tcb-alloc ( sockaddr inpcb tcb )
	61	2dup >tcb-inpcb ! over >in-ppcb ! ( sockaddr inpcb )
	62	2dup >in-socket ! swap >so-inpcb ! ( )
	63	;
	64
65	\ Close connection and deallocate Internet PCB and TCP control blocks.
66	: tcp-sodetach ( sockaddr -- )
67	dup so>tcb 0 TR_SOCKET PRREQ_DETACH tcp-trace ( sockaddr )
68	dup so>tcb dup tcp-close-connection ( sockaddr tcb )
69	dup tcb>inpcb swap tcb-free inpcb-free ( sockaddr )
70	0 swap >so-inpcb ! ( )
71	;
72
73	\ Bind local address and port number to socket.
74	: tcp-sobind ( sockaddr addr addrlen -- )
75	drop insock>addr,port dup 0= if ( sockaddr addr port )
76	drop tcp-next-port ( sockaddr addr lport )
77	then ( sockaddr addr lport )
78	rot so>inpcb -rot inpcb-bind ( )
79	;
80
81	\ Prepare to accept incoming connections. Only one pending connection
82	\ is supported.
83	: tcp-solisten ( sockaddr backlog -- 0 )
84	drop dup so>inpcb dup in-lport@ 0= if ( sockaddr inpcb )
85	my-ip-addr tcp-next-port inpcb-bind ( sockaddr )
86	else ( sockaddr inpcb )
87	drop ( sockaddr )
88	then ( sockaddr )
89	TCPS_LISTEN swap so>tcb tcb-state! ( )
90	0 ( result )
91	;
92
93	\ Accept a connection and return peer's IP address and port number to
94	\ caller. A new socket is not created (i.e, the listening socket is
95	\ the connected socket).
96	: tcp-soaccept ( sockaddr addr addrlen -- 0 \| error# )
97	2 pick so>tcb ( sockaddr addr addrlen tcb )
98	tcp-accept-connection ?dup if ( sockaddr addr addrlen error#)
99	>r 3drop r> ( error# )
100	else ( sockaddr addr addrlen )
101	/insock swap l! ( sockaddr addr )
102	>r so>inpcb r> in-getpeeraddr 0 ( 0 )
103	then ( 0 \| error# )
104	;
105
106	\ Initiate connection to peer.
107	: tcp-soconnect ( sockaddr srvaddr addrlen -- 0 \| error# )
108	drop over so>inpcb swap ( sockaddr inpcb addr )
109	over in-lport@ 0= if ( sockaddr inpcb addr )
110	over my-ip-addr tcp-next-port inpcb-bind ( sockaddr inpcb addr )
111	then ( sockaddr inpcb addr )
112	insock>addr,port inpcb-connect ( sockaddr )
113	so>tcb tcp-open-connection ( result )
114	;
115
116	\ Queue data in send buffer and send all the data we can.
117	: tcp-sosend ( sockaddr buf nbytes flags -- #sent \| error# )
118	drop rot so>tcb -rot ( tcb buf nbytes )
119	2 pick 0 TR_SOCKET PRREQ_SEND tcp-trace ( tcb buf nbytes )
120	begin ( tcb buf nbytes )
121	2 pick over tcp-canputdata? ( tcb buf nbytes flag )
122	0= while ( tcb buf nbytes )
123	2 pick tcb-error@ ?dup if ( tcb buf nbytes error# )
124	>r 3drop r> exit ( error# )
125	then ( tcb buf nbytes )
126	tcp-poll ( tcb buf nbytes )
127	repeat ( tcb buf nbytes )
128	2 pick >r tcp-putdata r> tcp-output ( #sent )
129	;
130
131	\ Read data from the receive buffer. Data in the receive buffer can be
132	\ read if we have enough data, or we are not expecting any more data,
133	\ or if data is being pushed.
134	: tcp-soreceive ( sockaddr buf nbytes flags -- #rcvd \| error# )
135	drop rot so>tcb -rot ( tcb buf nbytes )
136	begin ( tcb buf nbytes )
137	2 pick over tcp-cangetdata? ( tcb buf nbytes flag )
138	0= while ( tcb buf nbytes )
139	2 pick tcb-error@ ?dup if ( tcb buf nbytes error# )
140	>r 3drop r> exit ( error# )
141	then ( tcb buf nbytes )
142	tcp-poll ( tcb buf nbytes )
143	repeat ( tcb buf nbytes )
144	2 pick 0 TR_SOCKET PRREQ_RECV tcp-trace ( tcb buf nbytes )
145	tcp-getdata ( #rcvd )
146	;
147
148	\ Process a TCP user request.
149	: tcp-prreq-execute ( ?? req# -- ?? )
150	case
151	PRREQ_RECV of tcp-soreceive endof
152	PRREQ_SEND of tcp-sosend endof
153	PRREQ_ATTACH of tcp-soattach endof
154	PRREQ_DETACH of tcp-sodetach endof
155	PRREQ_BIND of tcp-sobind endof
156	PRREQ_CONNECT of tcp-soconnect endof
157	PRREQ_LISTEN of tcp-solisten endof
158	PRREQ_ACCEPT of tcp-soaccept endof
159	PRREQ_RECVFROM of 3drop 3drop EOPNOTSUPP endof \ Not supported
160	PRREQ_SENDTO of 3drop 3drop EOPNOTSUPP endof \ Not supported
161	( default ) ." Unknown TCP socket operation" -1 throw
162	endcase
163	;
164
165	headers