Writing FCode 2.x Programs
  Suchtext Nur in diesem Buch
Dieses Buch im PDF-Format herunterladen

Block and Byte Devices

6

Block Devices

Block devices are nonvolatile mass storage devices whose information can be accessed in any order. Examples of block devices include hard disks, floppy disks, and CD-ROMs. OpenBoot firmware typically uses block devices for booting.
This device type generally applies to disk devices, but as far as OpenBoot is concerned, it simply means that the device "looks like a disk" at the OpenBoot software interface level.
The block device FCode must declare the block device-type, and must implement the methods open and close, as well as the methods described below in "Required Methods" on page 78".
Although packages of the block device type present a byte-oriented interface to the rest of the system, the associated hardware devices are usually block-oriented i.e. the device reads and writes data in "blocks" (groups of, for example, 512 or 2048 bytes). The standard /deblocker support package assists in the presentation of a byte-oriented interface "on top of" an underlying block-oriented interface, implementing a layer of buffering that "hides" the underlying "block" length.
Block devices are often subdivided into several logical "partitions", as defined by a disk label - a special block, usually the first one, containing information about the device. The driver is responsible for appropriately interpreting a disk label. The driver may use the standard disk label support package if it does not
implement a specialized label. The /disk-label support package interprets a system-dependent label format. Since the disk booting protocol usually depends upon the label format; the standard disk label support package also implements a load method for the corresponding boot protocol.

Byte Devices

Byte devices are sequential-access mass storage devices, for example tape devices. OpenBoot firmware typically uses byte devices for booting.
The byte device FCode program must declare the byte device type, and must implement the open and close methods in addition to those described in "Required Methods";.
Although packages of the byte device type present a byte-oriented interface to the rest of the system, the associated hardware devices are usually record-oriented; the device reads and writes data in records containing more than one byte. The records may be fixed length or variable length. The standard /deblocker support package assists in presenting a byte-oriented interface on top of an underlying record-oriented interface, implementing a layer of buffering that hides the underlying record structure.

Required Methods


block-size( -- bytes )

All data transfers to or from the device are in records of n bytes each. The most common value for n is 512.
This method is only required if the /deblocker support package is used.

load( adr -- len )

load works a bit differently for block and byte devices:
With block devices, it loads a stand-alone program from the device into memory at adr. len is the size in bytes of the program loaded. If the device can contain several such programs, the instance arguments returned by my-args can be used to select the specific program desired. open is executed before load is invoked.
With byte devices, load reads a stand-alone program from the tape file specified by the value of the argument string given by my-args. That value is the string representation of a decimal integer. If the argument string is null, tape file 0 is used. load places the program in memory at adr, returning the size len of the read-in program in bytes.

max-transfer( -- bytes )

The size in bytes of the largest single transfer that the device can perform. max-transfer is expected to be a multiple of block-size.
This method is only required if the /deblocker support package is used.

read( adr len -- actual )

Read at most len bytes from the device into memory at adr. actual is the number of bytes actually read. If the number of bytes read is 0 or negative, the read failed. Note that len need not be a multiple of the device's normal block size.

read-blocks( adr block# #blocks -- #read )

Read #blocks records of length block-size bytes each from the device, starting at device block block#, into memory at address adr. #read is the number of blocks actually read.
This method is only required if the /deblocker support package is used.

seek( poslow poshigh -- error? ) for block

( offset file# -- error? )          for byte

seek works a bit differently depending on whether it's being used with a block or byte device.
For block devices, seek sets the device position for the next read or write. The position is the byte offset from the beginning of the device specified by the 64-bit number which is the concatenation of poshigh and poslow. error? is - 1 if the seek fails, and 0 if it succeeds.
For byte devices, it seeks to the byte offset within file file#. If offset and file# are both 0, rewind the tape. error? is -1 if seek fails, and 0 if seek succeeds.

write( adr len -- actual )

Write len bytes from memory at adr to the device. actual is the number of bytes actually written. If actual is less than len, the write did not succeed. If actual is -1, some other error occurred. len need not be a multiple of the device's normal block size.

write-blocks( adr block# #blocks -- #written )

Write #blocks records of length block-size bytes each to the device, starting at block block#, from memory at adr. #written is the number of blocks actually written.
This method is only required if the /deblocker support package is used.

Required Properties

Property NameSample Value
name"SUNW,googly"
regmy-address h# 12.0000 + my-space h# 20
device_type" block" or " byte"

Device Driver Examples

The structure of the device tree for the sample card supported by the sample device drivers in this chapter is as follows:

Grafik

Figure 6-1

Simple Block Device Driver


  \ This is at a stage where each leaf node can be used only as a  
  \ non-bootable device.  
  \ It only creates nodes and publishes necessary properties  
  \ to identify the device.  
  fcode-version1  
  hex  
     " SUNW,my-scsi"   xdrstring " name" attribute  
  
     3 xdrint " interrupts" attribute  
     3 0 intr  
  
     h# 20.0000    constant scsi-offset  
     h# 40        constant /scsi  
     my-address scsi-offset + my-space /scsi  reg  
     d# 25.000.000 xdrint  " clock-frequency" attribute  
  
     new-device   \ missing "reg" indicates a SCSI "wild-card" node  
        " sd"     xdrstring " name" attribute  


     finish-device  
  
     new-device   \ missing "reg" indicates a SCSI "wild-card" node  
         " st"     xdrstring " name" attribute  
     finish-device  
  end0  

Extended Block Device Driver


  \ sample driver for "my-scsi" device.  
  \ It is still a non-bootable device.  
  \ The purpose is to show how an intermediate stage of driver can  
  \ be used to debug board during development.  
  \ In addtion to publishing the properties, this sample driver  
  \ shows methods to access, test and control "SUNW,my-scsi" device.  
  \ Following main methods are provided for "SUNW,my-scsi" device.  
  \  open  ( -- success? )  
  \  close  ( -- )  
  \  reset  ( -- )  
  \  selftest  ( -- fail? )  
  fcode-version2  
     hex  
     headers  
  
     h# 20.0000    constant scsi-offset  
     h# 40        constant /scsi  
     d# 25.000.000 constant clock-frequency  
     my-address constant my-sbus-address  
     my-space   constant my-sbus-space  
  
     : identify-me ( -- )  
        " SUNW,my-scsi"   xdrstring " name" attribute  
        " scsi"                  device-type  
        \ sbus interrupt level generated by card  
        3 xdrint " interrupts" attribute  
        3 0 intr  
  
        my-sbus-address scsi-offset + my-sbus-space /scsi  reg  
        clock-frequency  xdrint  " clock-frequency" attribute  
     ;  
     identify-me  


  \ sample driver for "my-scsi" device.  
  
     \ Tokenizer 2.1 or later has the word 'instance'  
     : instance ( -- ) version h# 20001 >=  if  instance  then  ;  
  
     h# 10.0000 constant dma-offset  
     h# 10      constant /dma  
     -1 instance value dma-chip  
  
     \ methods to access/control dma registers  
     : dmaaddress  ( -- addr )  dma-chip 4 +  ;  
     : dmacount  ( -- addr )  dma-chip 8 +  ;  
     : dmaaddr@  ( -- n )  dmaaddress rl@  ;  
     : dmaaddr!  ( n -- )  dmaaddress rl!  ;  
     : dmacount@  ( -- n )  dmacount rl@  ;  
     : dmacount!  ( n -- )  dmacount rl!  ;  
     : dma-chip@  ( -- n )  dma-chip rl@  ;  
     : dma-chip!  ( n -- )  dma-chip rl!  ;  
     : dma-btest  ( mask -- flag )  dma-chip@  and  ;  
     : dma-bset  ( mask -- )  dma-chip@  or  dma-chip!  ;  
     : dma-breset  ( mask -- )  not dma-btest  dma-chip!  ;  
  
     external  
  
     \ methods to allocate, map, unmap, free dma buffers  
     : decode-unit  ( adr len -- low high )  decode-2int  ;  
     : dma-alloc  ( n -- vaddr )  " dma-alloc" $call-parent  ;  
     : dma-free  ( vaddr n -- )   " dma-free" $call-parent  ;  
     : dma-map-in  ( vaddr n cache? -- devaddr )  " dma-map-in" $call-parent  ;  
     : dma-map-out  ( vaddr devaddr n -- )       " dma-map-out" $call-parent  ;  
     \ Dma-sync could be dummy routine if parent device doesn't support.  
     : dma-sync  ( virt-addr dev-addr size -- )  
        " dma-sync" my-parent ['] $call-method catch  if  
           2drop 2drop 2drop  
        then  
     ;  
     : map-in ( adr space size -- virt ) " map-in" $call-parent  ;  
     : map-out ( virt size -- ) " map-out" $call-parent  ;  
  
     headers  
     : dma-open ( -- )  
        my-sbus-address dma-offset +  my-sbus-space  /dma  
        map-in  is dma-chip  
     ;  
     : dma-close ( -- )  


  \ sample driver for "my-scsi" device.  
        dma-chip /dma map-out  
        -1 is dma-chip  
     ;  
  
     -1 instance value scsi-init-id  
     -1 instance value scsi-chip  
     h# 20 constant /mbuf  
     -1 instance value mbuf  
     -1 instance value mbuf-dma  
     d# 6 constant /sense  
     -1 instance value sense-command  
     -1 instance value sense-cmd-dma  
     d# 8 constant #sense-bytes  
     -1 instance value sense-buf  
     -1 instance value sense-buf-dma  
     -1 instance value mbuf0  
     d# 12 constant /cmdbuf  
     -1 instance value cmdbuf  
     -1 instance value cmdbuf-dma  
     -1 instance value scsi-statbuf  
  
     \ mapping and allocation routines for scsi  
     : map-scsi-chip  ( -- )  
        my-sbus-address scsi-offset +  my-sbus-space /scsi map-in  
        is scsi-chip  
     ;  
     : unmap-scsi-chip  
        scsi-chip /scsi map-out  
        -1 is scsi-chip  
     ;  
  
     \ After any changes to sense-command by cpu or any changes  
     \ to sense-cmd-dma by device, synchronize changes by issuing  
     \ " sense-command sense-cmd-dma /sense dma-sync "  
     \ Similarly after any changes to sense-buf, sense-buf-dma,  
     \ mbuf, mbuf-dma, cmdbuf or cmdbuf-dma,  synchronize changes  
     \ by appropriately issuing dma-sync  
  
     \ map scsi chip and allocate buffers for "sense" command and status  
     : map-scsi  ( -- )  
        map-scsi-chip  
        /sense dma-alloc is sense-command  


  \ sample driver for "my-scsi" device.  
        sense-command /sense false  
        dma-map-in is sense-cmd-dma  
        #sense-bytes dma-alloc is sense-buf  
        sense-buf #sense-bytes false  
        dma-map-in is sense-buf-dma  
        2 alloc-mem is scsi-statbuf  
     ;  
  
     \ free buffers for "sense" command and status and unmap scsi chip  
     : unmap-scsi  ( -- )  
        scsi-statbuf 2 free-mem  
        sense-buf sense-buf-dma #sense-bytes dma-sync  \ redundant  
        sense-buf sense-buf-dma #sense-bytes dma-map-out  
        sense-buf #sense-bytes dma-free  
        sense-command sense-cmd-dma /sense dma-sync     \ redundant  
        sense-command sense-cmd-dma /sense dma-map-out  
        sense-command /sense dma-free  
        -1 is sense-command  
        -1 is sense-cmd-dma  
        -1 is sense-buf  
        -1 is scsi-statbuf  
        -1 is sense-buf-dma  
        unmap-scsi-chip  
     ;  
  
     \ constants related to scsi commands  
     h#  0 constant nop  
     h#  1 constant flush-fifo  
     h#  2 constant reset-chip  
     h#  3 constant reset-scsi  
     h# 80 constant dma-nop  
  
     \ words to get scsi register addresses.  
     \ Each chip register is one byte, aligned on a 4-byte boundary.  
     : scsi+  ( offset -- addr )  scsi-chip +  ;  
     : transfer-count-lo     ( -- addr )  h#  0 scsi+  ;  
     : transfer-count-hi     ( -- addr )  h#  4 scsi+  ;  
     : fifo                  ( -- addr )  h#  8 scsi+  ;  
     : command               ( -- addr )  h#  c scsi+  ;  
     : configuration         ( -- addr )  h# 20 scsi+  ;  
     : scsi-test-reg         ( -- addr )  h# 28 scsi+  ;  
  
     \ Read only registers:  
     : scsi-status           ( -- addr )  h# 10 scsi+  ;  


  \ sample driver for "my-scsi" device.  
     : interrupt-status      ( -- addr )  h# 14 scsi+  ;  
     : sequence-step         ( -- addr )  h# 18 scsi+  ;  
     : fifo-flags            ( -- addr )  h# 1c scsi+  ;  
  
     \ Write only registers:  
     : select/reconnect-bus-id  ( -- addr )  h# 10 scsi+  ;  
     : select/reconnect-timeout ( -- addr )  h# 14 scsi+  ;  
     : sync-period              ( -- addr )  h# 18 scsi+  ;  
     : sync-offset              ( -- addr )  h# 1c scsi+  ;  
     : clock-conversion-factor  ( -- addr )  h# 24 scsi+  ;  
  
     \ words to read from/store to scsi registers.  
     : cnt@      ( -- w )  
        transfer-count-lo rb@  
        transfer-count-hi rb@  
        bwjoin  
     ;  
     : fifo@     ( -- c )  fifo rb@  ;  
     : cmd@      ( -- c )  command rb@  ;  
     : stat@     ( -- c )  scsi-status rb@  ;  
     : istat@    ( -- c )  interrupt-status rb@  ;  
     : fifo-cnt  ( -- c )  fifo-flags rb@  h# 1f and ;  
     : data@     ( -- c )  begin  fifo-cnt  until  fifo@  ;  
     : seq@      ( -- c )  sequence-step rb@  h# 7 and ;  
  
     : fifo! ( c -- )  fifo rb!  ;  
     : cmd!      ( c -- )  command rb!  ;  
     : cnt!      ( w -- )  
        wbsplit  
        transfer-count-hi rb! transfer-count-lo rb!  
     ;  
     : targ!     ( c -- )  select/reconnect-bus-id rb!  ;  
     : data!     ( c -- )  begin  fifo-cnt d# 16 <>  until  fifo!  ;  
  
     \ scsi chip noop  and initialization  
     : scsi-nop   ( -- )  nop cmd!  ;  
     : init-scsi  ( -- )  reset-chip cmd!  scsi-nop  ;  
  
     : wait-istat-clear  ( -- error? )  
        d# 1000  
        begin  
           1 ms 1-  ( count )  
           dup 0=   ( count expired? )  


  \ sample driver for "my-scsi" device.  
           istat@   ( count expired? istat )  
           0= or    ( count clear? )  
        until       ( count )  
        0=  if  
           istat@ 0<>  if  
              cr ." Can't clear ESP interrupts: "  
              ." Check SCSI Term. Power Fuse." cr  
              true  exit  
           then  
        then  
        false  
     ;  
  
     : clk-conv-factor ( -- n )  
        clock-frequency d# 5.000.000 / 7 and  
     ;  
  
     \ initialize scsi chip, tune time amount,  
     \ set async operation mode, and set scsi bus id  
     : reset-my-scsi ( -- error? )  
        init-scsi  
        h# 93 select/reconnect-timeout rb!  
        0 sync-offset rb!  
        clk-conv-factor clock-conversion-factor rb!  
        h# 4 scsi-init-id 7 and or  configuration rb!  
        wait-istat-clear  
     ;  
  
     : reset-bus ( -- error? )  
        reset-scsi cmd!  wait-istat-clear  
     ;  
  
     : init-n-test  ( -- ok? ) reset-my-scsi 0=  ;  
  
     : get-buffers ( -- )  
        h# 8000 dma-alloc is mbuf0  
        /cmdbuf dma-alloc is cmdbuf  
        cmdbuf /cmdbuf false dma-map-in  
        is cmdbuf-dma  
     ;  
  
     : give-buffers ( -- )  
        mbuf0 h# 8000 dma-free  -1 is mbuf0  
        cmdbuf cmdbuf-dma /cmdbuf dma-sync             \ redundant  


  \ sample driver for "my-scsi" device.  
        cmdbuf cmdbuf-dma /cmdbuf dma-map-out  
        cmdbuf /cmdbuf dma-free  
        -1 is cmdbuf -1 is cmdbuf-dma  
     ;  
  
     : scsi-selftest ( -- fail? )  reset-my-scsi  ;  
  
     \ dma-alloc and dma-map-in mbuf-dma  
     : mbuf-alloc ( -- )  
        /mbuf dma-alloc is mbuf  
        mbuf /mbuf false dma-map-in is mbuf-dma  
     ;  
  
     \ dma-map-out and dma-free mbuf-dma  
     : mbuf-free ( -- )  
        mbuf mbuf-dma /mbuf dma-sync                \ redundant  
        mbuf mbuf-dma /mbuf dma-map-out  
        mbuf /mbuf dma-free  
        -1 is mbuf  
        -1 is mbuf-dma  
     ;  
  
     external  
     \ If any routine was actually using buffers allocated by dma-alloc,  
     \ and dma mapped by dma-map-in, it would have dma-sync those buffers  
     \ after any changes to them.  
     : open  ( -- success? )  
        dma-open  
        " scsi-initiator-id" get-inherited-attribute 0=  if  
           xdrtoint  is scsi-init-id  
           2drop  
           map-scsi  
           init-n-test                    ( ok? )  
           dup if                         ( true )  
              get-buffers                 ( true )  
           else  
              unmap-scsi dma-close        ( false )  
           then                           ( success? )  
        else  
           ." Missing initiator id" cr  false  
           dma-close  
        then                              ( success? )  
     ;  


  \ sample driver for "my-scsi" device.  
     : close  ( -- )  
        give-buffers unmap-scsi dma-close  
     ;  
  
     : reset  ( -- )  
        dma-open map-scsi  
        h# 80 dma-breset  
        reset-my-scsi drop reset-bus drop  
        unmap-scsi dma-close  
     ;  
  
     \ if scsi-selftest was actually using buffers allocated by mbuf-alloc,  
     \ it would have to do dma-sync after any changes to mbuf or mbuf-dma.  
     : selftest  ( -- fail? )  
        map-scsi  
        mbuf-alloc  
        scsi-selftest  
        mbuf-free  
        unmap-scsi  
     ;  
  
     new-device  \ missing "reg" indicates a SCSI "wild-card" node  
        " sd"     xdrstring " name" attribute  
     finish-device  
  
     new-device  \ missing "reg" indicates a SCSI "wild-card" node  
         " st"     xdrstring " name" attribute  
     finish-device  
  end0  

Complete Block and Byte Device Driver


  \ sample fcode driver for bootable devices.  
  \ It supports "block" and "byte" type bootable devices,  
  \ by using standard "deblocker" and "disk-label" packages.  
  
  fcode-version2  
     hex  
     headers  
  
     : copyright  ( -- )  
        ." Copyright 1990 Sun Microsystems, Inc.  All Rights Reserved" cr  
     ;  
     h# 20.0000    constant scsi-offset  
     h# 40        constant /scsi  
     d# 25.000.000 constant clock-frequency  
     my-address constant my-sbus-address  
     my-space   constant my-sbus-space  
  
     : identify-me ( -- )  
        " SUNW,my-scsi"   xdrstring " name" attribute  
        " scsi"                  device-type  
        3 xdrint " interrupts" attribute  
        3 0 intr  
        my-sbus-address scsi-offset + my-sbus-space /scsi  reg  
        clock-frequency  xdrint  " clock-frequency" attribute  
     ;  
     identify-me  
  
     \ Tokenizer 2.1 or later has the word 'instance'  
     : instance ( -- ) version h# 20001 >=  if  instance  then  ;  
  
  
     h# 10.0000 constant dma-offset  
     h# 10      constant /dma  
     -1 instance value dma-chip  
  
     external  
     : decode-unit  ( adr len -- low high )  decode-2int  ;  
     : dma-alloc  ( n -- vaddr )  " dma-alloc" $call-parent  ;  
     : dma-free  ( vaddr n -- )    " dma-free" $call-parent  ;  
     : dma-map-in  ( vaddr n cache? -- devaddr )  " dma-map-in" $call-parent  ;  
     : dma-map-out  ( vaddr devaddr n -- )       " dma-map-out" $call-parent  ;  


  \ sample fcode driver for bootable devices.  
     \ Dma-sync could be dummy routine if parent device doesn't support.  
     : dma-sync  ( virt-addr dev-addr size -- )  
        " dma-sync" my-parent ['] $call-method catch  if  
           2drop 2drop 2drop  
        then  
     ;  
  
     : map-in ( adr space size -- virt ) " map-in" $call-parent  ;  
     : map-out ( virt size -- ) " map-out" $call-parent  ;  
  
     headers  
     \ variables/values for sending commands, mapping etc.  
     -1 instance value scsi-init-id  
     -1 instance value scsi-chip  
     -1 instance value mbuf  
     -1 instance value mbuf-dma  
     h# 20 constant /mbuf  
     ...  
  
     \ mapping and allocation routines for scsi  
     : map-scsi-chip  ( -- )  
        my-address scsi-offset +  my-space /scsi map-in  
        is scsi-chip  
     ;  
  
     : unmap-scsi-chip  
        scsi-chip /scsi map-out  
        -1 is scsi-chip  
     ;  
  
     : map-scsi  ( -- )  
        map-scsi-chip  
        \ allocate buffers etc. for "sense" command and status  
        ...  
     ;  
  
     : unmap-scsi  ( -- )  
        \ free buffers etc. for "sense" command and status  
        ...  
        unmap-scsi-chip  
     ;  
  
     \ words related to scsi commands and register access.  
     ...  


  \ sample fcode driver for bootable devices.  
  
     : reset-my-scsi ( -- error? )   ...  ;  
     : reset-bus ( -- error? )   ...  ;  
  
     : init-n-test  ( -- ok? ) ...  ;  
     : get-buffers ( -- )  ...  ;  
     : give-buffers ( -- )  ...  ;  
     : scsi-selftest ( -- fail? )  ...  ;  
  
     d# 512 constant ublock  
     0 instance value /block  
     0 instance value /tapeblock  
     instance variable fixed-len?  
     ...  
  
     external  
     : set-timeout  ( n -- ) ...  ;  
     : send-diagnostic ( -- error? )  
          \ run diagnostics and return any error.  
          ...  
     ;  
  
     : device-present?  ( lun target -- present? ) ...  ;  
     : mode-sense  ( -- true | block-size false ) ...  ;  
     : read-capacity  ( -- true | block-size false ) ...  ;  
  
     \ Spin up a SCSI disk, coping with a possible wedged SCSI bus  
     : timed-spin  ( target lun -- ) ...  ;  
  
     : disk-r/w-blocks ( adr block# #blocks direction? -- #xfered )  
        ...                 ( #xfered )  
     ;  
  
     \ Execute "mode-sense" command.  If failed, execute read-capacity command.  
     \ If this also failed, return d# 512 as the block size.  
     : disk-block-size  ( -- n )  
         mode-sense  if  read-capacity  if  d# 512  then  then  
         dup is /block  
     ;  
  
     : tape-block-size ( -- n ) ...  ;  
     : fixed-or-variable  ( -- max-block fixed? )  ...  ;  
     : tape-r/w-some  ( adr block# #blks read? -- actual# error? ) ...  ;  


  \ sample fcode driver for bootable devices.  
  
     headers  
     : dma-open ( -- )  
        my-address dma-offset +  my-space  /dma  
        map-in  is dma-chip  
     ;  
     : dma-close ( -- )  
        dma-chip /dma map-out  
        -1 is dma-chip  
     ;  
  
     \ After any changes to mbuf by cpu or any changes  
     \ to mbuf-dma by device, synchronize changes by issuing  
     \ " mbuf mbuf-dma /mbuf dma-sync "  
     : mbuf-alloc ( -- )  
        /mbuf dma-alloc is mbuf  
        mbuf /mbuf false dma-map-in is mbuf-dma  
     ;  
  
     \ dma-map-out and dma-free mbuf-dma  
     : mbuf-free ( -- )  
        mbuf mbuf-dma /mbuf dma-sync              \ redundant  
        mbuf mbuf-dma /mbuf dma-map-out  
        mbuf /mbuf dma-free  
        -1 is mbuf  
        -1 is mbuf-dma  
     ;  
  
     external  
     \ external methods for scsi bus ( "SUNW,my-scsi" node)  
     : open  ( -- success? )  
        dma-open  
        " scsi-initiator-id" get-inherited-attribute 0=  if  
           xdrtoint  is scsi-init-id  
           2drop  
           map-scsi  
           init-n-test                    ( ok? )  
           dup if                         ( true )  
              get-buffers                 ( true )  
           else  
              unmap-scsi dma-close        ( false )  
           then                           ( success? )  
        else  
           ." Missing initiator id" cr  false  


  \ sample fcode driver for bootable devices.  
          dma-close  
        then                              ( success? )  
     ;  
  
     : close  ( -- )  give-buffers unmap-scsi dma-close  ;  
  
     : reset  ( -- )  
        dma-open map-scsi  
        ...  
        reset-my-scsi drop reset-bus drop  
        unmap-scsi dma-close  
     ;  
  
     : selftest  ( -- fail? )  
        map-scsi  
        mbuf-alloc  
        scsi-selftest  
        mbuf-free  
        unmap-scsi  
     ;  
  
     headers  
  
  \ start of child block device  
  
     new-device  \ missing "reg" indicates SCSI "wild-card" node  
  
        " sd"     xdrstring " name" attribute  
        " block"        device-type  
  
        0 instance value offset-low  
        0 instance value offset-high  
        0 instance value label-package  
  
        \ The "disk-label" package interprets the disk label,  
        \ interpreting any partition information contained in  
        \ the disk label. The "load" method of "block" device  
        \ uses load method provided by "disk-label"  
        : init-label-package  ( -- okay? )  
           0 is offset-high  0 is offset-low  
           my-args  " disk-label"  $open-package is label-package  
           label-package  if  
              0 0  " offset" label-package $call-method  
              is offset-high is offset-low  


  \ sample fcode driver for bootable devices.  
              true  
           else  
              ." Can't open disk label package"  cr  false  
           then  
        ;  
  
        0 instance value deblocker  
        : init-deblocker  ( -- okay? )  
           " "  " deblocker"  $open-package  is deblocker  
           deblocker  if  
              true  
           else  
              ." Can't open deblocker package"  cr  false  
           then  
        ;  
  
        : device-present? ( lun target -- present? )  
           " device-present?" $call-parent  
        ;  
  
        \ Following methods are needed for "block" device:  
        \ open, close, selftest, reset, read, write, load, seek,  
        \ block-size, max-transfer, read-blocks, write-blocks.  
        \ Carefully notice the relationship between methods for  
        \ "block" device and methods pre-defined for  
        \ "disk-label" and "deblocker"  
  
        external  
        \ external methods for "block" device ( "sd" node)  
  
        : spin-up  ( -- )  my-unit  " timed-spin" $call-parent  ;  
  
        : open  ( -- ok? )  
           my-unit device-present?  0=  if  false exit  then  
           spin-up      \ Start the disk if necessary  
  
           init-deblocker  0=  if  false exit  then  
           init-label-package  0=  if  
              deblocker close-package false exit  
           then  
           true  
        ;  
  
        : close  ( -- )  


  \ sample fcode driver for bootable devices.  
           label-package close-package  0 is label-package  
           deblocker close-package  0 is deblocker  
        ;  
  
        : selftest ( -- fail? )  
           my-unit device-present?  if  
              " send-diagnostic" $call-parent  ( fail? )  
           else  
              true                             ( error )  
           then  
        ;  
        : reset  ( -- )  ...   ;  
  
        \ The "deblocker" package assists in the implementation  
        \ of byte-oriented read and write methods for disks and  
        \ tapes. The deblocker provides a layer of buffering to  
        \ implement a high level byte-oriented interface  
        \ "on top of" a low-level block-oriented interface.  
  
        \ The "seek", "read" and "write" methods of this block  
        \ device use corresponding methods provided by "deblocker"  
  
        \ In order to be able to use "deblocker" package this  
        \ device has to define following four methods, which the  
        \ deblocker uses as its low-level interface to the device:  
        \ 1) block-size, 2) max-transfer, 3) read-blocks and  
        \ 4) write-blocks  
  
        : block-size ( -- n )   " disk-block-size" $call-parent  ;  
        : max-transfer ( -- n ) block-size h# 40 * ;  
  
        : read-blocks  ( adr block# #blocks -- #read )  
           true " disk-r/w-blocks" $call-parent  
        ;  
        : write-blocks  ( adr block# #blocks -- #written )  
           false " disk-r/w-blocks" $call-parent  
        ;  
  
        : dma-alloc ( #bytes -- vadr ) " dma-alloc" $call-parent  ;  
        : dma-free  ( vadr #bytes -- ) " dma-free" $call-parent  ;  
        : seek  ( offset.low offset.high -- okay? )  
           offset-low offset-high  x+  " seek"   deblocker $call-method  
        ;  


  \ sample fcode driver for bootable devices.  
        : read  ( adr len -- actual-len )  " read"  deblocker $call-method  ;  
        : write ( adr len -- actual-len )  " write" deblocker $call-method  ;  
        : load  ( adr -- size )        " load"  label-package $call-method  ;  
  
     finish-device  \ finishing "block" device "sd"  
  
     headers  
  
  \ start of child byte device  
  
     new-device  \ missing "reg" indicates "wild-card" node  
        " st"     xdrstring " name" attribute  
        " byte"        device-type  
  
        false instance value write-eof-mark?  
        instance variable file-mark?  
        true instance value scsi-tape-first-install  
  
        : scsi-tape-rewind     ( -- [[xstatbuf] f-hw] error? ) ... ;  
  
        : write-eof  ( -- [[xstatbuf] f-hw] error? ) ...  ;  
  
        0 instance value deblocker  
        : init-deblocker  ( -- okay? )  
           " "  " deblocker"  $open-package  is deblocker  
           deblocker  if  
              true  
           else  
              ." Can't open deblocker package"  cr  false  
           then  
        ;  
  
        : flush-deblocker  ( -- )  
           deblocker close-package  init-deblocker drop  
        ;  
        : fixed-or-variable ( -- max-block fixed? )  
           " fixed-or-variable" $call-parent  
        ;  
  
        : device-present? ( lun target -- present? )  
           " device-present?" $call-parent  
        ;  
  
        \ Following methods are needed for "byte" device:  


  \ sample fcode driver for bootable devices.  
        \ open, close, selftest, reset, read, write, load, seek,  
        \ block-size, max-transfer, read-blocks, write-blocks.  
        \ Carefully notice the relationship between methods for  
        \ "byte" device and methods pre-defined for  
        \ standard deblocker package.  
  
        external  
        \ external methods for "byte" device ( "st" node)  
  
        \ The "deblocker" package assists in the implementation  
        \ of byte-oriented read and write methods for disks and  
        \ tapes. The deblocker provides a layer of buffering to  
        \ implement a high level byte-oriented interface  
        \ "on top of" a low-level block-oriented interface.  
  
        \ The "read" and "write" methods of this "byte"  
        \ device use corresponding methods provided by "deblocker"  
  
        \ In order to be able to use "deblocker" package this  
        \ device has to define following four methods, which the  
        \ deblocker uses as its low-level interface to the device:  
        \ 1) block-size, 2) max-transfer, 3) read-blocks and  
        \ 4) write-blocks  
        : block-size  ( -- n )   " tape-block-size" $call-parent  ;  
  
        : max-transfer  ( -- n )  
           fixed-or-variable  ( max-block fixed? )  
           if  
              \ Use the largest multiple of /tapeblock that is <= h# fe00  
              h# fe00  over  / *  
           then  
        ;  
  
        : read-blocks  ( adr block# #blocks -- #read )  
           file-mark? @  0=  if  
              true " tape-r/w-some" $call-parent  file-mark? !   ( #read )  
           else  
              3drop 0  
           then  
        ;  
  
        : write-blocks  ( adr block# #blocks -- #written )  
           false " tape-r/w-some" $call-parent file-mark? !  
        ;  


  \ sample fcode driver for bootable devices.  
  
  
        : dma-alloc ( #bytes -- vadr ) " dma-alloc" $call-parent  ;  
        : dma-free  ( vadr #bytes -- ) " dma-free" $call-parent  ;  
        : open  ( -- okay? )  \ open for tape  
           my-unit  device-present?  0=  if  false exit  then  
           scsi-tape-first-install  if  
              scsi-tape-rewind  if  
                 ." Can't rewind tape" cr  
                 0= if  drop  then  
                 false exit  
              then  
              false is scsi-tape-first-install  
           then  
           \ Set fixed-len? and /tapeblock  
           fixed-or-variable 2drop  
           init-deblocker  0=  if  false exit  then  
           true  
        ;  
        : close  ( -- )  
           deblocker close-package  0 is deblocker  
           write-eof-mark?  if  
              write-eof  if  
                 ." Can't write EOF Marker."  
                 0=  if  drop  then  
              then  
           then  
        ;  
        : reset  ( -- )  ...   ;  
        : selftest ( -- fail? )  
           my-unit device-present?  if  
              " send-diagnostic" $call-parent  ( fail? )  
           else  
              true                             ( error )  
           then  
        ;  
  
        : read  ( adr len -- actual-len )  " read"  deblocker $call-method  ;  
        : write ( adr len -- actual-len )  
           true is write-eof-mark?  
           " write" deblocker $call-method  
        ;  


  \ sample fcode driver for bootable devices.  
  
        : load  ( adr -- size )  
           \ use my-args to get tape file-no  
           ...  ( adr file# )  
  
           \ position at requested file  
           ...  
           dup  begin                   ( start-adr next-adr )  
              dup max-transfer read     ( start-adr next-adr #read )  
              dup 0>                    ( start-adr next-adr #read got-some? )  
           while                        ( start-adr next-adr #read )  
              +                         ( start-adr next-adr' )  
           repeat                       ( start-adr end-adr 0 )  
           drop swap -                  ( size )  
        ;  
  
        : seek  ( byte# file# -- error? )  
           \ position at requested file  
           ...                                    ( byte# )  
  
           flush-deblocker                        ( byte# )  
           begin  dup 0>  while                   ( #remaining )  
              " mbuf0" $call-parent  
              over ublock min  read               ( #remaining #read )  
              dup  0=  if                         ( #remaining 0 )  
                 2drop  true  
                 exit                             ( error )  
              then                                ( #remaining #read )  
              -                                   ( #remaining' )  
           repeat                                 ( 0 )  
           drop false                             ( no-error )  
        ;  
  
     finish-device  \ finishing "byte" device "st"  
  end0  
  \ finishing "SUNW,my-scsi"