kmx git

\ ========== 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
openbios/openboot/obp/pkg/netinet/tcp-reqs.fth

Commit

obp/pkg/netinet/tcp-reqs.fth
