Initial commit of OpenSPARC T2 architecture model.

[OpenSPARC-T2-SAM] / obp / obp / pkg / asr-ds / asr-ds.fth

\ ========== Copyright Header Begin ==========================================
\ 
\ Hypervisor Software File: asr-ds.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: @(#)asr-ds.fth 1.2 07/04/10
purpose:
copyright: Copyright 2007 Sun Microsystems, Inc.  All Rights Reserved
copyright: Use is subject to license terms.

headerless

1 		value asr-major
0 		value asr-minor
h# 4153524f4250 value asr-svc-handle	\ ASROBP

\ ASR Query Request
struct
   /l	field >asr-cmd
constant /asr-hdr

\ ASR Query Response
struct
   /l   field >query-result
   /l   field >query-status
constant /query-response


d# 1024 /asr-hdr + constant /max-asr-response
/max-asr-response buffer: asr-buf

: asr-cmd!		( cmd pkt -- )  	>asr-cmd l!  ;
: asr-cmd@		( pkt -- cmd )  	>asr-cmd l@  ;
: >asr-payload		( pkt -- payload-adr )  /asr-hdr +  ;

\ message types
9 	constant ASR-QUERY-REQ
h# 19	constant ASR-QUERY-RES

\ ASR Result Codes
0	constant ASR-CMD-OK
1	constant ASR-CMD-FAILED

\ Query Response Status Codes
0	constant ASR-QUERY-ENABLED
1	constant ASR-QUERY-DISABLED

\ To coordinate handoffs between Solaris and OBP the state of the 
\ domain-service channel is stored away.  If OBP needs to use the channel
\ after it has been closed it will attempt to re-register its needed service
0 	constant ASR-CLOSED
1 	constant ASR-OPEN
2 	constant ASR-ERROR

ASR-CLOSED value asr-service-state

\ Domain-service interfaces
\ Send buffer on the given service channel
: send-ds-data  ( buf len svc-handle -- error? )
   [ also domain-services ] send-ds-data [ previous ]
;

\ Receive a packet of at most len from the given service channel
: receive-ds-data  ( buf len svc-handle -- len' 0 | error )
   [ also domain-services ] receive-ds-data [ previous ]
;

\ Attempt to register $svc-id with svc-handle.  Returns error/ack/nack
: register-domain-service ( maj min svc-han $svc-id -- maj/min ack? 0 | -1 )
   [ also domain-services ] register-domain-service [ previous ]
;

\ Unregister the domain service negotiated on svc-handle
: unregister-domain-service  ( svc-handle -- error? )
   [ also domain-services ] unregister-domain-service [ previous ]
;

also ldc

\ service IDs with Null Character embedded
\ Note: for now only asr-backup service to VBSC is used...
: $asr  	( -- $ )  " asr"(00)"  ;
: $asr-backup	( -- $ )  " asr-backup"(00)"  ;

: init-service  ( -- error? )  
   asr-major asr-minor asr-svc-handle $asr-backup
   register-domain-service ?dup 0= if 			( maj/min ack? )
      nip 0=						( nack? )
   then
;

\ Attempt to Register asr service
: asr-init  ( -- error? )
   init-service				( error? )
   dup if
      ASR-CLOSED to asr-service-state
   else
      ASR-OPEN to asr-service-state
   then
;

\ Unregister the asr service
: asr-close  ( -- )
   asr-svc-handle unregister-domain-service ?dup if     (  )
      \ If LDC is not up then it has been reset, treat this as closed LDC
      \ which can be re-opened for later operations.
      LDC-NOTUP = if                                    (  )
         ASR-CLOSED to asr-service-state                (  )
      else                                              (  )
         ASR-ERROR to asr-service-state                 (  )
      then                                              (  )
   else							(  )
      ASR-CLOSED to asr-service-state			(  )
   then
   asr-svc-handle 1+ to asr-svc-handle	\ new handle in case of re-register
;

\ Bring up the asr channel unless it is in the ERROR state
: check-asr-channel-state  ( -- error? )
   asr-service-state case
      ASR-OPEN 		of	 0	endof
      ASR-CLOSED	of asr-init	endof
      ASR-ERROR		of 	-1	endof
   endcase
;

: asr-response?  ( cmd -- asr-response? )
   dup ASR-QUERY-RES = 
;

\ Wait for asr response request
: receive-asr-response  ( -- buf len 0 | error )
   asr-buf dup /max-asr-response asr-svc-handle ( buf buf len handle )
   receive-ds-data ?dup if			( buf len' | buf error )
      dup LDC-NOTUP = if			( buf error )
	 cmn-warn[ " Waiting for ASR response but LDC is Not Up!" ]cmn-end
         ASR-CLOSED to asr-service-state
      then					( buf error )
      nip					( error )
   else						( buf len' )
      dup 0= if					( buf len' )
         cmn-warn[ " No ASR response from Domain Service Providor " ]cmn-end
         2drop -1 exit				( -1 )
      then
      0						( buf len 0 )
   then						( buf len 0 | error )
;

: $cstrput ( str len dest-adr -- end-adr )
   swap  2dup ca+ >r  move  0 r@ c!  r> ca1+
;

d# 1024 buffer: str-buf

\ " foo" " bar" becomes " foo"(00)"bar"(00)"
: cat-with-nulls ( str len str2 len2 -- str' len' )
   2swap				( str2 len2 str len )
   dup 3 pick + >r			( str2 len2 str len ) ( r: len' )
   str-buf $cstrput $cstrput drop	(  )		      ( r: len' )
   str-buf r> 2+			( str' len' )
;


\ Wrap query data to be sent to the domain services layer
: assemble-query-pkt  ( $nexus $unit -- pkt len )
   cat-with-nulls				( $data )
   tuck asr-buf					( data-len $data pkt )
   ASR-QUERY-REQ over asr-cmd!			( data-len $name pkt )
   >asr-payload swap move			( data-len )
   asr-buf swap /asr-hdr +			( pkt len )
;

: asr-query  ( $nexus $unit -- $response 0 | -1 )
   check-asr-channel-state if			( $nexus $unit )
      2drop 2drop true exit			( true )
   then						( $nexus $unit )
   assemble-query-pkt				( buf len )
   asr-svc-handle send-ds-data ?dup if		( error |  )
      LDC-NOTUP = if
         cmn-warn[ " Sending ASR Query packets but LDC is Not Up!" ]cmn-end
	 \ Mark state to closed so that it can be re-opened later
	 ASR-CLOSED to asr-service-state
      then
      cmn-warn[ " Error sending ASR Query packets - transaction failed" ]cmn-end
      -1 exit
   then
   receive-asr-response	?dup if			( $pkt status )
      cmn-warn[ " Error receiving ASR Query Response" ]cmn-end
   else
      drop dup asr-cmd@ ASR-QUERY-RES = if	( pktbuf )
         >asr-payload /query-response 0		( $response 0 )
      else					( pktbuf )
         drop -1				( -1 )
      then					( $response 0 | -1 )
   then						( $response 0 | -1 )
;

previous 	\ LDC

headers

\      0   The device corresponding to the key is OK.
\ 	 (There is no asr-entry in the asr-db for the device.)
\     -1   The device corresponding to the key is disabled

: query  ( nexus$ unit$ -- status )
   asr-query if					(  )
      cmn-warn[ " ASR Query Failed - No Response" ]cmn-end
      0	\ probe the device anyway		( 0 )
   else						( $response )      
      drop dup >query-result l@			( buf result )
      ASR-CMD-FAILED = if			( buf )
         cmn-warn[ " ASR Query Failed - Command Failed" ]cmn-end
         drop 0	\ probe the device anyway	( 0 )
      else					( buf )
         >query-status l@			( status )

	\ At this time, VBSC only returns 0 for enabled and 1 for disabled
	\ OBP probing code treats status < 0 as "device disabled". The previous
	\ implementation of ASR had a very complex scheme for changing the 1
	\ from vbsc into a -1. That complexity was premature as VBSC never
	\ returned enough information to make complex decisions.  Until it does
	\ this code just treats any non-zero return status as "DISABLED"

         if  -1  else  0  then			( status' )
      then					( status' )
   then						( status' )
;

: open  ( -- okay? )
   check-asr-channel-state 0=
;

: close  ( -- )  
   asr-close
;