Initial commit of OpenSPARC T2 architecture model.
[OpenSPARC-T2-SAM] / obp / obp / dev / sun4v-devices / legion-disk / methods.fth
\ ========== Copyright Header Begin ==========================================
\
\ Hypervisor Software File: methods.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: @(#)methods.fth 1.1 06/02/16
purpose:
copyright: Copyright 2006 Sun Microsystems, Inc. All Rights Reserved
copyright: Use is subject to license terms.
headers
" block" device-type
headerless
0 instance value offset-low \ Offset to start of partition
0 instance value offset-high
0 instance value label-package
0 instance value deblocker
: init-deblocker ( -- okay? )
" " " deblocker" $open-package to deblocker
deblocker if
true
else
." Can't open deblocker package" cr false
then
;
: init-label-package ( -- okay? )
0 to offset-high 0 to offset-low
my-args " disk-label" $open-package to label-package
label-package if
0 0 " offset" label-package $call-method to offset-high to offset-low
true
else
." Can't open disk label package" cr false
then
;
defer claim
defer release
: init-clientserv ( -- okay? )
" /openprom/client-services" find-package if
>r " claim" r@ find-method if
to claim
" release" r> find-method if
to release true
else
r> drop false
then
else
false
then
else
false
then
;
: disk-read ( size raddr offset -- #bytes|errno error? ) -rot swap 3 2 h# f0 h# 80 htrap ;
: disk-write ( size raddr offset -- #bytes|errno error? ) -rot swap 3 2 h# f1 h# 80 htrap ;
-1 h# 1fff - constant page#mask
h# 2000 constant mmu-pagesize
external
: block-size ( -- n ) d# 512 ;
: dma-alloc ( size -- vaddr ) mmu-pagesize swap 0 claim ;
: dma-free ( vaddr size -- ) swap release ;
: dma-sync ( virt-addr dev-addr size -- ) 3drop ;
: dma-map-out ( vaddr devaddr n -- ) 3drop ;
: dma-map-in ( vaddr size cache? -- devaddr )
2drop ( vaddr )
dup >physical drop ( vaddr papage )
swap page#mask invert and or ( pa )
;
headerless
: r/w-blocks ( addr block# #blocks read? -- #read/#written )
over >r >r ( addr block# #blocks ) ( r: #blocks read? )
block-size * -rot ( size addr block# ) ( r: #blocks read? )
block-size * >r ( size addr ) ( r: #blocks read? offset )
2dup over true ( size addr size addr size cache? ) ( r: #blocks read? offset )
dma-map-in ( size addr size devaddr ) ( r: #blocks read? offset )
tuck r> r> if ( size addr devaddr size devaddr offset ) ( r: #blocks )
disk-read ( size addr devaddr #bytes|errno error? ) ( r: #blocks )
else ( size addr devaddr size devaddr offset ) ( r: #blocks )
disk-write ( size addr devaddr #bytes|errno error? ) ( r: #blocks )
then if ( size addr devaddr errno ) ( r: #blocks )
r> 2drop ( size addr devaddr 0 )
else ( size addr devaddr #bytes ) ( r: #blocks )
r> drop ( size addr devaddr #read|#written )
then ( size addr devaddr #read|#written )
block-size / >r rot ( addr devaddr size ) ( r: #read|#written )
3dup dma-sync ( addr devaddr size ) ( r: #read|#written )
dma-map-out r> ( #read|#written )
;
external
\ These three methods are called by the deblocker.
: max-transfer ( -- #bytes ) h# 8000 ;
: read-blocks ( addr block# #blocks -- #read ) true r/w-blocks ;
: write-blocks ( addr block# #blocks -- #written ) false r/w-blocks ;
: #blocks ( -- true | n false ) true ;
: open ( -- flag )
init-clientserv 0= if false exit then
init-deblocker 0= if false exit then
init-label-package 0= if
deblocker close-package false exit
then
true
;
: close ( -- )
label-package close-package
deblocker close-package
;
: seek ( offset.low offset.high -- okay? )
offset-low offset-high d+ " seek" deblocker $call-method
;
: read ( addr len -- actual-len ) " read" deblocker $call-method ;
: write ( addr len -- actual-len ) " write" deblocker $call-method ;
: load ( addr -- size ) " load" label-package $call-method ;
: size ( -- d.size ) " size" label-package $call-method ;
headerless