Writing FCode 3.x Programs
この本のみを検索
PDF 文書ファイルをダウンロードする

Memory-Mapped Buses

8

This chapter discusses addressing and required properties for memory-mapped buses.
A memory-mapped bus logically extends the processor's memory address space to include the devices on that bus. This enables the children of the bus device to be mapped into the CPU address space and accessed like memory using processor load and store cycles to address those children directly.
SBus and VMEbus are examples of memory-mapped buses.
Not all bus devices fall into this category. For example, SCSI is not a memory-mapped bus; SCSI targets are not accessed with load or store instructions.

Required Methods

A memory-mapped bus package code must implement the open, close, reset, and selftest methods, as well as the following:
decode-unit ( addr len -- phys.lo ... phys.hi )
Convert addr len, a text string representation, to phys.lo ... phys.hi, a numerical representation of a physical address in the address space defined by this package. The format of phys.lo ... phys.hi varies from bus to bus.
dma-alloc ( size -- virt )
Allocate a virtual address range of length size bytes that is suitable for direct memory access by a bus master device. The memory is allocated according to the most stringent alignment requirements for the bus. virt is a 32-bit address that the OpenBoot-based system can use to access the memory.
Note that dma-map-in must also be called to generate a suitable DMA address.
A child of a memory-mapped device calls dma-alloc using

   " dma-alloc" $call-parent  

For example:

  -1 value my-vaddr  
  : my-dma-alloc ( size -- )  
     " dma-alloc"  $call-parent  to my-vaddr  
  ;  

dma-free ( virt size -- )
Free size bytes of memory previously allocated by dma-alloc at the virtual address virt.
A child of a memory-mapped device calls dma-free by using

   " dma-free" $call-parent  

For example:

  2000 value my-size  
  : my-dma-free  ( -- )  
     my-vaddr my-size " dma-free"  $call-parent  
     -1 to my-vaddr  
  ;  

dma-map-in ( virt size cacheable? -- devaddr )
Convert the virtual address range virt size, previously allocated by dma-alloc, into an address devaddr suitable for DMA on the bus. dma-map-in can also be used to map application-supplied data buffers for DMA use if the
bus allows. If cacheable? is true, the calling child desires to use any available fast caches for the DMA buffer. If access to the buffer is required before the buffer is mapped out, the child must call dma-sync or dma-map-out to ensure cache coherency with memory.
A child of a memory-mapped device calls dma-map-in using

   " dma-map-in" $call-parent  

For example:

  : my-vaddr-dma-map ( -- )  
     my-vaddr my-size false " dma-map-in"  $call-parent   ( devaddr )  
     to my-vaddr-dma  
  ;  

dma-map-out ( virt devaddr size -- )
Remove the DMA mapping previously created with dma-map-in. Flush all caches associated with the mapping.
A child of a memory-mapped device calls dma-map-out by using

   " dma-map-out" $call-parent  

For example:

  : my-vaddr-dma-free ( -- )  
     my-vaddr my-vaddr-dma my-size " dma-map-out"  $call-parent  
     -1 to my-vaddr-dma  
  ;  

dma-sync ( virt devaddr size -- )
Synchronize (flush) any memory caches associated with the DMA mapping previously established by dma-map-in. You must interleave calls to this method (or dma-map-out) between DMA and CPU accesses to the memory region, or you may not obtain the most recent data written into the cache.
For example, a child of a hierarchical device calls dma-sync by using $call-parent. This method is valid for FCode version 2.1 or later. Some early version 2 systems do not define this method in the /sbus node. Those systems automatically synchronize DMA and CPU access. The following example will give correct results in all cases.

  : my-dma-sync ( virt devadr size -- )  
     " dma-sync" $call-parent  
  ;  

probe-self ( arg-addr arg-len reg-addr reg-len fcode-addr fcode-len -- )
Probe for a child of this node. fcode-addr fcode-len is a unit-address text string that identifies the location of the FCode program for the child. reg-addr reg-len is a probe-address text string that identifies the address of the child itself. arg-addr arg-len is an instance-arguments text string for any device arguments for the child (which can be retrieved in the child's FCode program with the my-args FCode). probe-self checks whether there is indeed FCode at the indicated location, perhaps by mapping the device and using cpeek to ensure that the device is present and that the first byte is a valid FCode start byte.
If the FCode exists, probe-self creates a new child device node and interprets the FCode. If the interpretation of the FCode fails in some way, the new device node may be empty, containing no properties or methods.
For example, to probe FCode for SBus slot #1:

  " /sbus" open-dev  
  0 0 " 1,0" 2dup probe-self  
  device-end  

map-in ( phys.lo ... phys.hi size -- virt )
Create a mapping associating the range of physical addresses beginning at phys.lo ... phys.hi extending for size bytes in the package's physical address space with a processor virtual address virt.
The number of cells in the list phys.lo ... phys.hi is determined by the value of the "#address-cells" property of the node containing map-in.
For example, a child of a memory-mapped device calls map-in with " map-in" $call-parent. (The following example assumes that the value of the parent's "#address-cells" property is 3):

  : map-reg ( -- )  
     my-address xx-offset 0 d+ my-space  ( phys.lo phys.mid phys.hi )  
     xx-size " map-in" $call-parent      ( virt )  
     to xx-vaddr                         ( )  
  ;  

map-out ( virt size -- )
Destroy the mapping set by map-in at virtual address virt of length size bytes. For example, a child of a memory-mapped device calls map-out with " map-out" $call-parent:

  : unmap-reg ( -- )  
     xx-vaddr xx-size           ( virt size )  
     " map-out" $call-parent    ( )  
     -1 to xx-vaddr  
  ;  

SBus Addressing

The SBus uses geographical addressing with numbered slots. An SBus physical address is represented numerically by the SBus slot number as the high number and the offset from the base of that slot as the low number. The text string representation is slot#, offset where both slot# and offset are the ASCII representations of hexadecimal numbers.

SBus Required Properties

Table 8-1
Property NameSample Value
name" SUNW,fas"
burst-sizes
device_type" sbus"
ranges
slot-address-bits

Device Driver Examples

The following examples of a hierarchical FCode driver are based on Sun's SBus expansion hardware, XBox. XBox increases the number of SBus slots available in a system by providing a bus-bridge between the platform's onboard SBus and an SBus in the XBox hardware. XBox includes an SBus card called the XAdaptor card which plugs into the host platform's SBus and includes an expansion chassis called the XBox Expansion Box. Therefore XBox is an example of a hierarchical device which implements an SBus interface to child plug-in devices.
The example is divided into three parts: the basic device driver, the extended device driver, and the complete device driver. In the case of a hierarchical device, in practice, one would only want to develop and ship a driver with the complete functionality. Otherwise, plug-in cards which rely on a full set of parent services generally would not be able to function. The three stage presentation of the driver simply shows how a driver might grow through the development cycle.

Basic Hierarchical Device Driver

The basic driver simply declares most of the important properties of the device, particularly the addresses of the various registers. A driver in this state might be used to support the development of the OS driver which would attach to the device name and configure itself based on the device properties published by the FCode driver.
Code Example 8-1 Basic Hierarchical Device Driver

  hex  
  fcode-version2  
  
  " SUNW,xbox"  name  
  " 501-1840"   model  
  
  \ XBox Registers  
  \ XAdaptor card registers  
  h#       0 constant write0-offset    h# 4 constant /write0  
  h#  2.0000 constant xac-err-offset   h# c constant /xac-err  
  h# 10.0000 constant xac-ctl0-offset  h# 4 constant /xac-ctl0  
  h# 11.0000 constant xac-ctl1-offset  h# 4 constant /xac-ctl1  
  h# 12.0000 constant xac-elua-offset  h# 4 constant /xac-elua  
  h# 13.0000 constant xac-ella-offset  h# 4 constant /xac-ella  
  h# 14.0000 constant xac-ele-offset   h# 4 constant /xac-ele  
  
  \ XBox Exapnsion box registers  
  h# 42.0000 constant xbc-err-offset   h# c constant /xbc-err  
  h# 50.0000 constant xbc-ctl0-offset  h# 4 constant /xbc-ctl0  
  h# 51.0000 constant xbc-ctl1-offset  h# 4 constant /xbc-ctl1  
  h# 52.0000 constant xbc-elua-offset  h# 4 constant /xbc-elua  
  h# 53.0000 constant xbc-ella-offset  h# 4 constant /xbc-ella  
  h# 54.0000 constant xbc-ele-offset   h# 4 constant /xbc-ele  
  
  : >reg-spec ( offset size -- xdrreg )  
     >r my-address + my-space encode-phys r> encode-int encode+  
  ;  
  
  write0-offset    /write0    >reg-spec  
  xac-err-offset   /xac-err   >reg-spec  encode+  
  xac-ctl0-offset  /xac-ctl0  >reg-spec  encode+  
  xac-ctl1-offset  /xac-ctl1  >reg-spec  encode+  
  xac-elua-offset  /xac-elua  >reg-spec  encode+  
  xac-ella-offset  /xac-ella  >reg-spec  encode+  

Code Example 8-1 Basic Hierarchical Device Driver (Continued)

  xac-ele-offset   /xac-ele   >reg-spec  encode+  
  xbc-err-offset   /xbc-err   >reg-spec  encode+  
  xbc-ctl0-offset  /xbc-ctl0  >reg-spec  encode+  
  xbc-ctl1-offset  /xbc-ctl1  >reg-spec  encode+  
  xbc-elua-offset  /xbc-elua  >reg-spec  encode+  
  xbc-ella-offset  /xbc-ella  >reg-spec  encode+  
  xbc-ele-offset   /xbc-ele   >reg-spec  encode+  
  " reg" property  
  
  \ Xbox can interrupt on any SBus level  
  
  1 encode-int       2 encode-int encode+  3 encode-int encode+  4 encode-int  
  encode+  
  5 encode-int encode+  6 encode-int encode+  7 encode-int encode+  
  " interrupts"  property  
  
  1 sbus-intr>cpu encode-int       0 encode-int encode+  
  2 sbus-intr>cpu encode-int encode+  0 encode-int encode+  
  3 sbus-intr>cpu encode-int encode+  0 encode-int encode+  
  4 sbus-intr>cpu encode-int encode+  0 encode-int encode+  
  5 sbus-intr>cpu encode-int encode+  0 encode-int encode+  
  6 sbus-intr>cpu encode-int encode+  0 encode-int encode+  
  7 sbus-intr>cpu encode-int encode+  0 encode-int encode+  
  " intr" property  
  
  \ XBox bus clock speed  
  d# 25.000.000 encode-int  " clock-frequency"  property  
  
  \ Burst sizes 64,32,16,8,4,2,1 bursts.  
  h# 7f encode-int  " burst-sizes"  property  
  
  \ XBox has no slave-only slots  
  0 encode-int  " slave-only" property  
  
  \ Get the number of address bits for this SBus slot from the parent SBus  
  \ node without inheritance .  OpenBoot 2.5 doesn't publish slot-address-bits.  
  \ However 2.5 is only on 4m machines, which are all 28 bits per slot.  
  
  : $=  ( addr1 len1 addr2 len2 -- equal? )        \ string compare  
     rot over -  if  
        drop 2drop  false                          \ different lengths  
     else  comp 0=  
     then  

Code Example 8-1 Basic Hierarchical Device Driver (Continued)

  ;  
  : 4mhack  ( -- n )  
     " compatible" get-inherited-property  if  
        d# 25                                \ no "compatible" prop; assume 4c  
     else  decodestring  " sun4m" $=  if  
           d# 28  
        else  
           d# 25                             \ not sun4m  
        then  
        nip nip  
     then  
  ;  
  : #bits  ( -- n )  
     " slot-address-bits"  my-parent ihandle>phandle  
     get-package-property  if  
        4mhack  
     else  
        decode-int  nip nip  
     then  
  ;  
  #bits constant  host-slot-size  
  host-slot-size encode-int  " slot-address-bits" property  
  
  end0  

Extended Hierarchical Device Driver

The extended driver adds methods allowing access to various device registers in addition to the functions of the basic driver. It provides methods to:
  • Map in the registers
  • Fetch from and store to the registers
  • Program one of the registers which control the allocation of address space across the various SBus slots.
Such an extended driver provides methods that a developer can use to read and write registers and verify correct hardware responses. Note that the complete driver does not use all of the device registers; read/write access methods were included for all of them to allow easy testing during development.
Code Example 8-2 Extended Hierarchical Device Driver

  \ extended hierarchical device driver sample  
  
  hex  
  fcode-version2  
  
  " SUNW,xbox"  name  
  " 501-1840"   model  
  
  \ XBox Registers  
  
  h#       0 constant write0-offset    h# 4 constant /write0  
  h#  2.0000 constant xac-err-offset   h# c constant /xac-err  
  h# 10.0000 constant xac-ctl0-offset  h# 4 constant /xac-ctl0  
  h# 11.0000 constant xac-ctl1-offset  h# 4 constant /xac-ctl1  
  h# 12.0000 constant xac-elua-offset  h# 4 constant /xac-elua  
  h# 13.0000 constant xac-ella-offset  h# 4 constant /xac-ella  
  h# 14.0000 constant xac-ele-offset   h# 4 constant /xac-ele  
  
  h# 42.0000 constant xbc-err-offset   h# c constant /xbc-err  
  h# 50.0000 constant xbc-ctl0-offset  h# 4 constant /xbc-ctl0  
  h# 51.0000 constant xbc-ctl1-offset  h# 4 constant /xbc-ctl1  
  h# 52.0000 constant xbc-elua-offset  h# 4 constant /xbc-elua  
  h# 53.0000 constant xbc-ella-offset  h# 4 constant /xbc-ella  
  h# 54.0000 constant xbc-ele-offset   h# 4 constant /xbc-ele  
  
  : >reg-spec ( offset size -- xdrreg )  
     >r my-address + my-space encode-phys r> encode-int encode+  

Code Example 8-2 Extended Hierarchical Device Driver (Continued)

  \ extended hierarchical device driver sample  
  ;  
  
  write0-offset    /write0    >reg-spec  
  xac-err-offset   /xac-err   >reg-spec  encode+  
  xac-ctl0-offset  /xac-ctl0  >reg-spec  encode+  
  xac-ctl1-offset  /xac-ctl1  >reg-spec  encode+  
  xac-elua-offset  /xac-elua  >reg-spec  encode+  
  xac-ella-offset  /xac-ella  >reg-spec  encode+  
  xac-ele-offset   /xac-ele   >reg-spec  encode+  
  xbc-err-offset   /xbc-err   >reg-spec  encode+  
  xbc-ctl0-offset  /xbc-ctl0  >reg-spec  encode+  
  xbc-ctl1-offset  /xbc-ctl1  >reg-spec  encode+  
  xbc-elua-offset  /xbc-elua  >reg-spec  encode+  
  xbc-ella-offset  /xbc-ella  >reg-spec  encode+  
  xbc-ele-offset   /xbc-ele   >reg-spec  encode+  
  " reg" property  
  
  \ Xbox can interrupt on any SBus level  
  
  1 encode-int       2 encode-int encode+  3 encode-int encode+  4 encode-int  
  encode+  
  5 encode-int encode+  6 encode-int encode+  7 encode-int encode+  
  " interrupts"  property  
  
  1 sbus-intr>cpu encode-int       0 encode-int encode+  
  2 sbus-intr>cpu encode-int encode+  0 encode-int encode+  
  3 sbus-intr>cpu encode-int encode+  0 encode-int encode+  
  4 sbus-intr>cpu encode-int encode+  0 encode-int encode+  
  5 sbus-intr>cpu encode-int encode+  0 encode-int encode+  
  6 sbus-intr>cpu encode-int encode+  0 encode-int encode+  
  7 sbus-intr>cpu encode-int encode+  0 encode-int encode+  
  " intr" property  
  
  \ XBox bus clock speed  
  d# 25.000.000 encode-int  " clock-frequency"  property  
  
  \ Burst sizes 64,32,16,8,4,2,1 bursts.  
  h# 7f encode-int  " burst-sizes"  property  
  
  \ XBox has no slave-only slots  
  0 encode-int  " slave-only" property  
  
  \ Get the number of address bits for this SBus slot from the parent SBus  

Code Example 8-2 Extended Hierarchical Device Driver (Continued)

  \ extended hierarchical device driver sample  
  \ node without inheritance .  OpenBoot 2.5 doesn't publish slot-address-bits.  
  \ However 2.5 is only on 4m machines, which are all 28 bits per slot.  
  
  : $=  ( addr1 len1 addr2 len2 -- equal? )        \ string compare  
     rot over -  if  
        drop 2drop  false                          \ different lengths  
     else  comp 0=  
     then  
  ;  
  : 4mhack  ( -- n )  
     " compatible" get-inherited-property  if  
        d# 25                                \ no "compatible" prop; assume 4c  
     else  decodestring  " sun4m" $=  if  
           d# 28  
        else  
           d# 25                             \ not sun4m  
        then  
        nip nip  
     then  
  ;  
  : #bits  ( -- n )  
     " slot-address-bits"  my-parent ihandle>phandle  
     get-package-property  if  
        4mhack  
     else  
        decode-int  nip nip  
     then  
  ;  
  #bits constant  host-slot-size  
  host-slot-size encode-int  " slot-address-bits" property  
  
  \ Utility display string  
  : .me  ( -- )  ." SBus "  my-space .d  ." XBox "  ;  
  
  \ The XBox device has two modes opaque and transparent.  
  
  \ Upon reset the device is set to opaque mode.  In this mode all  
  \ accesses to address space of the device are directed to the XBox H/W  
  \ (ie. XAdaptor Card or the XBox Expansion Box) itself.  
  
  \ In the transparent mode all accesses are mapped to the SBus cards  
  \ which are plugged into the XBox.  In transparent mode the XBox H/W is  

Code Example 8-2 Extended Hierarchical Device Driver (Continued)

  \ extended hierarchical device driver sample  
  \ accessible only via the "write-0" register. To allow another bus  
  \ bridge to be plugged into the XBox all writes to the write-0 register  
  \ must contain a "key" which is programmed into the XBox H/W at boot  
  \ time. If the key field of a write to write-0 matches that programmed  
  \ at boot time the H/W intercepts the write.  Otherwise the H/W passes  
  \ the write along.  
  
  \ The XBox has two sets of registers. Those of the XAdaptor card and  
  \ and those of the XBox Expansion Box.  
  
  \ Opaque mode host adapter registers  
  -1  value xac-err-regs  
  -1  value xac-ctl0     -1  value xac-ctl1  
  -1  value xac-elua     -1  value xac-ella  
  -1  value xac-ele  
  \ Opaque mode expansion box registers  
  -1  value xbc-err-regs  
  -1  value xbc-ctl0     -1  value xbc-ctl1  
  -1  value xbc-elua     -1  value xbc-ella  
  -1  value xbc-ele  
  \ Transparent mode register  
  -1  value write0-reg  
  
  : xbox-map-in  ( offset space size -- virt ) " map-in"  $call-parent ;  
  : xbox-map-out ( virt size -- )              " map-out" $call-parent ;  
  : map-regs  ( -- )  
     write0-offset   my-address + my-space /write0   xbox-map-in  to write0-reg  
     xac-err-offset  my-address + my-space /xac-err  xbox-map-in  to xac-err-regs  
     xac-ctl0-offset my-address + my-space /xac-ctl0 xbox-map-in  to xac-ctl0  
     xac-ctl1-offset my-address + my-space /xac-ctl1 xbox-map-in  to xac-ctl1  
     xac-elua-offset my-address + my-space /xac-elua xbox-map-in  to xac-elua  
     xac-ella-offset my-address + my-space /xac-ella xbox-map-in  to xac-ella  
     xac-ele-offset  my-address + my-space /xac-ele  xbox-map-in  to xac-ele  
     xbc-err-offset  my-address + my-space /xbc-err  xbox-map-in  to xbc-err-regs  
     xbc-ctl0-offset my-address + my-space /xbc-ctl0 xbox-map-in  to xbc-ctl0  
     xbc-ctl1-offset my-address + my-space /xbc-ctl1 xbox-map-in  to xbc-ctl1  
     xbc-elua-offset my-address + my-space /xbc-elua xbox-map-in  to xbc-elua  
     xbc-ella-offset my-address + my-space /xbc-ella xbox-map-in  to xbc-ella  
     xbc-ele-offset  my-address + my-space /xbc-ele  xbox-map-in  to xbc-ele  
  ;  
  : unmap-regs  ( -- )  
     write0-reg   /write0    xbox-map-out   -1 to write0-reg  
     xac-err-regs /xac-err   xbox-map-out   -1 to xac-err-regs  

Code Example 8-2 Extended Hierarchical Device Driver (Continued)

  \ extended hierarchical device driver sample  
     xac-ctl0     /xac-ctl0  xbox-map-out   -1 to xac-ctl0  
     xac-ctl1     /xac-ctl1  xbox-map-out   -1 to xac-ctl1  
     xac-elua     /xac-elua  xbox-map-out   -1 to xac-elua  
     xac-ella     /xac-ella  xbox-map-out   -1 to xac-ella  
     xac-ele      /xac-ele   xbox-map-out   -1 to xac-ele  
     xbc-err-regs /xbc-err   xbox-map-out   -1 to xbc-err-regs  
     xbc-ctl0     /xbc-ctl0  xbox-map-out   -1 to xbc-ctl0  
     xbc-ctl1     /xbc-ctl1  xbox-map-out   -1 to xbc-ctl1  
     xbc-elua     /xbc-elua  xbox-map-out   -1 to xbc-elua  
     xbc-ella     /xbc-ella  xbox-map-out   -1 to xbc-ella  
     xbc-ele      /xbc-ele   xbox-map-out   -1 to xbc-ele  
  ;  
  
  \ Opaque mode register access words  
  
  : xac-errd@  ( -- l )  xac-err-regs     rl@  ;  
  : xac-erra@  ( -- l )  xac-err-regs 4 + rl@  ;  
  : xac-errs@  ( -- l )  xac-err-regs 8 + rl@  ;  
  : xac-ctl0@  ( -- w )  xac-ctl0 rl@  ;  
  : xac-ctl0!  ( w -- )  xac-ctl0 rl!  ;  
  : xac-ctl1@  ( -- w )  xac-ctl1 rl@  ;  
  : xac-ctl1!  ( w -- )  xac-ctl1 rl!  ;  
  : xac-elua@  ( -- l )  xac-elua rl@  ;  
  : xac-elua!  ( l -- )  xac-elua rl!  ;  
  : xac-ella@  ( -- w )  xac-ella rl@  ;  
  : xac-ella!  ( w -- )  xac-ella rl!  ;  
  
  : xbc-errd@  ( -- l )  xbc-err-regs rl@  ;  
  : xbc-erra@  ( -- l )  xbc-err-regs 4 + rl@  ;  
  : xbc-errs@  ( -- l )  xbc-err-regs 8 + rl@  ;  
  : xbc-ctl0@  ( -- w )  xbc-ctl0 rl@  ;  
  : xbc-ctl0!  ( w -- )  xbc-ctl0 rl!  ;  
  : xbc-ctl1@  ( -- w )  xbc-ctl1 rl@  ;  
  : xbc-ctl1!  ( w -- )  xbc-ctl1 rl!  ;  
  : xbc-elua@  ( -- l )  xbc-elua rl@  ;  
  : xbc-elua!  ( l -- )  xbc-elua rl!  ;  
  : xbc-ella@  ( -- w )  xbc-ella rl@  ;  
  : xbc-ella!  ( w -- )  xbc-ella rl!  ;  
  
  \ Transparent Mode register access words  
  
  external  
  : unique-key  ( -- n )  " unique-key" $call-parent  ;  

Code Example 8-2 Extended Hierarchical Device Driver (Continued)

  \ extended hierarchical device driver sample  
  headers  
  unique-key constant my-key  
  my-key encode-int  " write0-key" property  
  
  : xbox!  ( w offset -- )  my-key h# 18 << or or   write0-reg rl!  ;  
  
  : write-xac-ctl0  ( w -- )  xac-ctl0-offset xbox! ;  
  : write-xac-ctl1  ( w -- )  xac-ctl1-offset xbox! ;  
  : write-xbc-ctl0  ( w -- )  xbc-ctl0-offset xbox! ;  
  : write-xbc-ctl1  ( w -- )  xbc-ctl1-offset xbox! ;  
  
  \ Some functionally oriented words  
  
  : set-key        ( -- )  my-key 8 <<  xac-ctl0!  ;  
  : transparent    ( -- )             1 xac-ctl1!  ;  
  : opaque         ( -- )        0 write-xac-ctl1  ;  
  : enable-slaves  ( -- )    h# 38 write-xbc-ctl1  ;  
  
  : xbox-errors  ( -- xbc-err xac-err )  
     opaque  xbc-errd@ xac-errd@  transparent  
  ;  
  
  : ?.errors  ( xbc-err xac-err -- )  
     dup h# 8000.0000 and  if  
        cr .me  ." xac-error " .h cr  
     else  drop  
     then  
     dup h# 8000.0000 and  if  
        cr .me  ." xbc-error " .h cr  
     else drop  
     then  
  ;  
  
  \ The address space of the XBox in transparent mode may be dynamically  
  \ allocated across its plug-in slots.  This is called the  
  \ upper-address-decode-map (uadm).  Below is a table which relates the  
  \ slot configuration code which is programmed in hardware to the  
  \ allocation of address space for each slot.  The number in each cell is  
  \ the number of address bits needed for the slot.  
  
  decimal  
  create slot-sizes-array  
  \ slot0 slot1 slot2 slot3    slot-config  

Code Example 8-2 Extended Hierarchical Device Driver (Continued)

  \ extended hierarchical device driver sample  
    23 c, 23 c, 23 c, 23 c,     \ 00  
    23 c, 23 c, 23 c, 23 c,     \ 01  
    23 c, 23 c, 23 c, 23 c,     \ 02  
    23 c, 23 c, 23 c, 23 c,     \ 03  
    25 c,  0 c,  0 c,  0 c,     \ 04  
     0 c, 25 c,  0 c,  0 c,     \ 05  
     0 c,  0 c, 25 c,  0 c,     \ 06  
     0 c,  0 c,  0 c, 25 c,     \ 07  
    24 c, 24 c,  0 c,  0 c,     \ 08  
    24 c,  0 c, 24 c,  0 c,     \ 09  
     0 c, 24 c, 24 c,  0 c,     \ 0a  
     0 c,  0 c,  0 c,  0 c,     \ 0b  
    24 c, 23 c, 23 c,  0 c,     \ 0c  
    23 c, 24 c, 23 c,  0 c,     \ 0d  \ Overridden in code  
    23 c, 23 c, 24 c,  0 c,     \ 0e  \ Overridden in code  
    25 c,  0 c,  0 c,  0 c,     \ 0f  
    26 c, 26 c, 26 c, 26 c,     \ 10  
    26 c, 26 c, 26 c, 26 c,     \ 11  
    26 c, 26 c, 26 c, 26 c,     \ 12  
    26 c, 26 c, 26 c, 26 c,     \ 13  
    28 c,  0 c,  0 c,  0 c,     \ 14  
     0 c, 28 c,  0 c,  0 c,     \ 15  
     0 c,  0 c, 28 c,  0 c,     \ 16  
     0 c,  0 c,  0 c, 28 c,     \ 17  
    28 c, 28 c, 28 c, 28 c,     \ 18  
    28 c, 28 c, 28 c, 28 c,     \ 19  
    28 c, 28 c, 28 c, 28 c,     \ 1a  
    28 c, 28 c, 28 c, 28 c,     \ 1b  
     0 c,  0 c,  0 c,  0 c,     \ 1c  
     0 c,  0 c,  0 c,  0 c,     \ 1d  
     0 c,  0 c,  0 c,  0 c,     \ 1e  
     0 c,  0 c,  0 c,  0 c,     \ 1f  
  hex  
  
  20 constant /slot-sizes-array  
  -1 value slot-config  
  
  : >slot-size  ( slot# -- size )  
     slot-sizes-array  slot-config la+  swap ca+ c@  1 swap <<  
     1 not and         \ Could have slot size of 0.  
  ;  
  
  \ This array is to be filled with offsets for each slot.  

Code Example 8-2 Extended Hierarchical Device Driver (Continued)

  \ extended hierarchical device driver sample  
  \ Eg. 0, 100.0000, 180.0000, 200.0000  
  create host-offsets  0 , 0 , 0 , 0 ,  
  
  : >host-offset  ( child-slot# -- adr )  host-offsets swap na+ @  ;  
  
  create config-d-offsets  h# 100.0000 , 0           ,  h# 180.0000 ,  0 ,  
  create config-e-offsets  h# 100.0000 , h# 180.0000 ,  0           ,  0 ,  
  
  : set-host-offsets  ( -- )  
     slot-config  case  
        h# d of  config-d-offsets host-offsets 4 /n* move  exit  endof  
        h# e of  config-e-offsets host-offsets 4 /n* move  exit  endof  
     endcase  
     0                               ( initial-offset )  
     4 0  do                         ( offset )  
        dup host-offsets i na+ !     ( offset )  
        i >slot-size +               ( offset' )  
     loop                            ( final-offset )  
     drop  
  ;  
  
  : set-configuration  ( config-code -- )  
     is slot-config  
     set-host-offsets  
     slot-config 3 <<  my-key 8 << or  
     dup write-xac-ctl0                \ set XAC  
         write-xbc-ctl0                \ set XBC  
     slot-config encode-int  " uadm" property    \ publish slot configuration  
  ;  
  
  end0  

Complete Hierarchical Device Driver

The complete driver includes all the required device node methods. It also includes code to initialize the hardware at system reset. In particular, it configures the allocation of address space across slots. It does this by either performing an autoconfiguration or by accepting a manual override via a property in its parent. During the configuration process, the driver interprets the FCode of any SBus card plugged into the XBox. This results in devices being added to the device tree.
Code Example 8-3 Complete Hierarchical Device Driver

  \ complete hierarchical device driver sample  
  hex  
  fcode-version2  
  
  " SUNW,xbox"  name  
  " 501-1840"   model  
  " sbus"       device-type  
  
  \ XBox Registers  
  
  h#       0 constant write0-offset    h# 4 constant /write0  
  h#  2.0000 constant xac-err-offset   h# c constant /xac-err  
  h# 10.0000 constant xac-ctl0-offset  h# 4 constant /xac-ctl0  
  h# 11.0000 constant xac-ctl1-offset  h# 4 constant /xac-ctl1  
  h# 12.0000 constant xac-elua-offset  h# 4 constant /xac-elua  
  h# 13.0000 constant xac-ella-offset  h# 4 constant /xac-ella  
  h# 14.0000 constant xac-ele-offset   h# 4 constant /xac-ele  
  
  h# 42.0000 constant xbc-err-offset   h# c constant /xbc-err  
  h# 50.0000 constant xbc-ctl0-offset  h# 4 constant /xbc-ctl0  
  h# 51.0000 constant xbc-ctl1-offset  h# 4 constant /xbc-ctl1  
  h# 52.0000 constant xbc-elua-offset  h# 4 constant /xbc-elua  
  h# 53.0000 constant xbc-ella-offset  h# 4 constant /xbc-ella  
  h# 54.0000 constant xbc-ele-offset   h# 4 constant /xbc-ele  
  
  : >reg-spec ( offset size -- xdrreg )  
     >r my-address + my-space encode-phys r> encode-int encode+  
  ;  
  
  write0-offset    /write0    >reg-spec  
  xac-err-offset   /xac-err   >reg-spec  encode+  
  xac-ctl0-offset  /xac-ctl0  >reg-spec  encode+  
  xac-ctl1-offset  /xac-ctl1  >reg-spec  encode+  

Code Example 8-3 Complete Hierarchical Device Driver (Continued)

  \ complete hierarchical device driver sample  
  xac-elua-offset  /xac-elua  >reg-spec  encode+  
  xac-ella-offset  /xac-ella  >reg-spec  encode+  
  xac-ele-offset   /xac-ele   >reg-spec  encode+  
  xbc-err-offset   /xbc-err   >reg-spec  encode+  
  xbc-ctl0-offset  /xbc-ctl0  >reg-spec  encode+  
  xbc-ctl1-offset  /xbc-ctl1  >reg-spec  encode+  
  xbc-elua-offset  /xbc-elua  >reg-spec  encode+  
  xbc-ella-offset  /xbc-ella  >reg-spec  encode+  
  xbc-ele-offset   /xbc-ele   >reg-spec  encode+  
  " reg" property  
  
  \ Xbox can interrupt on any SBus level  
  
  1 encode-int       2 encode-int encode+  3 encode-int encode+  4 encode-int  
  encode+  
  5 encode-int encode+  6 encode-int encode+  7 encode-int encode+  
  " interrupts"  property  
  
  1 sbus-intr>cpu encode-int       0 encode-int encode+  
  2 sbus-intr>cpu encode-int encode+  0 encode-int encode+  
  3 sbus-intr>cpu encode-int encode+  0 encode-int encode+  
  4 sbus-intr>cpu encode-int encode+  0 encode-int encode+  
  5 sbus-intr>cpu encode-int encode+  0 encode-int encode+  
  6 sbus-intr>cpu encode-int encode+  0 encode-int encode+  
  7 sbus-intr>cpu encode-int encode+  0 encode-int encode+  
  " intr" property  
  
  \ XBox bus clock speed  
  d# 25.000.000 encode-int  " clock-frequency"  property  
  
  \ Burst sizes 64,32,16,8,4,2,1 bursts.  
  h# 7f encode-int  " burst-sizes"  property  
  
  \ XBox has no slave-only slots  
  0 encode-int  " slave-only" property  
  
  \ Get the number of address bits for this SBus slot from the parent SBus  
  \ node without inheritance .  OpenBoot 2.5 doesn't publish slot-address-bits.  
  \ However 2.5 is only on 4m machines, which are all 28 bits per slot.  
  
  : $=  ( addr1 len1 addr2 len2 -- equal? )        \ string compare  
     rot over -  if  
        drop 2drop  false                          \ different lengths  

Code Example 8-3 Complete Hierarchical Device Driver (Continued)

  \ complete hierarchical device driver sample  
     else  comp 0=  
     then  
  ;  
  : 4mhack  ( -- n )  
     " compatible" get-inherited-property  if  
        d# 25                                \ no "compatible" prop; assume 4c  
     else  decode-string  " sun4m" $=  if  
           d# 28  
        else  
           d# 25                             \ not sun4m  
        then  
        nip nip  
     then  
  ;  
  : #bits  ( -- n )  
     " slot-address-bits"  my-parent ihandle>phandle  
     get-package-property  if  
        4mhack  
     else  
        decode-int  nip nip  
     then  
  ;  
  #bits constant  host-slot-size  
  host-slot-size encode-int  " slot-address-bits" property  
  
  \ Utility display string  
  : .me  ( -- )  ." SBus "  my-space .d  ." XBox "  ;  
  
  \ The XBox device has two modes opaque and transparent.  
  
  \ Upon reset the device is set to opaque mode.  In this mode all  
  \ accesses to address space of the device are directed to the XBox H/W  
  \ (ie. XAdaptor Card or the XBox Expansion Box) itself.  
  
  \ In the transparent mode all accesses are mapped to the SBus cards  
  \ which are plugged into the XBox.  In transparent mode the XBox H/W is  
  \ accessible only via the "write-0" register. To allow another bus  
  \ bridge to be plugged into the XBox all writes to the write-0 register  
  \ must contain a "key" which is programmed into the XBox H/W at boot  
  \ time. If the key field of a write to write-0 matches that programmed  
  \ at boot time the H/W intercepts the write.  Otherwise the H/W passes  
  \ the write along.  

Code Example 8-3 Complete Hierarchical Device Driver (Continued)

  \ complete hierarchical device driver sample  
  
  \ The XBox has two sets of registers. Those of the XAdaptor card and  
  \ and those of the XBox Expansion Box.  
  
  \ Opaque mode host adapter registers  
  -1  value xac-err-regs  
  -1  value xac-ctl0     -1  value xac-ctl1  
  -1  value xac-elua     -1  value xac-ella  
  -1  value xac-ele  
  \ Opaque mode expansion box registers  
  -1  value xbc-err-regs  
  -1  value xbc-ctl0     -1  value xbc-ctl1  
  -1  value xbc-elua     -1  value xbc-ella  
  -1  value xbc-ele  
  \ Transparent mode register  
  -1  value write0-reg  
  
  : xbox-map-in  ( offset space size -- virt") " map-in"  $call-parent ;  
  : xbox-map-out ( virt size -- )              " map-out" $call-parent ;  
  : map-regs  ( -- )  
     write0-offset   my-address + my-space /write0   xbox-map-in  to write0-reg  
     xac-err-offset  my-address + my-space /xac-err  xbox-map-in  to xac-err-regs  
     xac-ctl0-offset my-address + my-space /xac-ctl0 xbox-map-in  to xac-ctl0  
     xac-ctl1-offset my-address + my-space /xac-ctl1 xbox-map-in  to xac-ctl1  
     xac-elua-offset my-address + my-space /xac-elua xbox-map-in  to xac-elua  
     xac-ella-offset my-address + my-space /xac-ella xbox-map-in  to xac-ella  
     xac-ele-offset  my-address + my-space /xac-ele  xbox-map-in  to xac-ele  
     xbc-err-offset  my-address + my-space /xbc-err  xbox-map-in  to xbc-err-regs  
     xbc-ctl0-offset my-address + my-space /xbc-ctl0 xbox-map-in  to xbc-ctl0  
     xbc-ctl1-offset my-address + my-space /xbc-ctl1 xbox-map-in  to xbc-ctl1  
     xbc-elua-offset my-address + my-space /xbc-elua xbox-map-in  to xbc-elua  
     xbc-ella-offset my-address + my-space /xbc-ella xbox-map-in  to xbc-ella  
     xbc-ele-offset  my-address + my-space /xbc-ele  xbox-map-in  to xbc-ele  
  ;  
  : unmap-regs  ( -- )  
     write0-reg   /write0    xbox-map-out   -1 to write0-reg  
     xac-err-regs /xac-err   xbox-map-out   -1 to xac-err-regs  
     xac-ctl0     /xac-ctl0  xbox-map-out   -1 to xac-ctl0  
     xac-ctl1     /xac-ctl1  xbox-map-out   -1 to xac-ctl1  
     xac-elua     /xac-elua  xbox-map-out   -1 to xac-elua  
     xac-ella     /xac-ella  xbox-map-out   -1 to xac-ella  
     xac-ele      /xac-ele   xbox-map-out   -1 to xac-ele  
     xbc-err-regs /xbc-err   xbox-map-out   -1 to xbc-err-regs  

Code Example 8-3 Complete Hierarchical Device Driver (Continued)

  \ complete hierarchical device driver sample  
     xbc-ctl0     /xbc-ctl0  xbox-map-out   -1 to xbc-ctl0  
     xbc-ctl1     /xbc-ctl1  xbox-map-out   -1 to xbc-ctl1  
     xbc-elua     /xbc-elua  xbox-map-out   -1 to xbc-elua  
     xbc-ella     /xbc-ella  xbox-map-out   -1 to xbc-ella  
     xbc-ele      /xbc-ele   xbox-map-out   -1 to xbc-ele  
  ;  
  
  \ Opaque mode register access words  
  
  : xac-errd@  ( -- l )  xac-err-regs     rl@  ;  
  : xac-erra@  ( -- l )  xac-err-regs 4 + rl@  ;  
  : xac-errs@  ( -- l )  xac-err-regs 8 + rl@  ;  
  : xac-ctl0@  ( -- w )  xac-ctl0 rl@  ;  
  : xac-ctl0!  ( w -- )  xac-ctl0 rl!  ;  
  : xac-ctl1@  ( -- w )  xac-ctl1 rl@  ;  
  : xac-ctl1!  ( w -- )  xac-ctl1 rl!  ;  
  : xac-elua@  ( -- l )  xac-elua rl@  ;  
  : xac-elua!  ( l -- )  xac-elua rl!  ;  
  : xac-ella@  ( -- w )  xac-ella rl@  ;  
  : xac-ella!  ( w -- )  xac-ella rl!  ;  
  
  : xbc-errd@  ( -- l )  xbc-err-regs rl@  ;  
  : xbc-erra@  ( -- l )  xbc-err-regs 4 + rl@  ;  
  : xbc-errs@  ( -- l )  xbc-err-regs 8 + rl@  ;  
  : xbc-ctl0@  ( -- w )  xbc-ctl0 rl@  ;  
  : xbc-ctl0!  ( w -- )  xbc-ctl0 rl!  ;  
  : xbc-ctl1@  ( -- w )  xbc-ctl1 rl@  ;  
  : xbc-ctl1!  ( w -- )  xbc-ctl1 rl!  ;  
  : xbc-elua@  ( -- l )  xbc-elua rl@  ;  
  : xbc-elua!  ( l -- )  xbc-elua rl!  ;  
  : xbc-ella@  ( -- w )  xbc-ella rl@  ;  
  : xbc-ella!  ( w -- )  xbc-ella rl!  ;  
  
  \ Transparent Mode register access words  
  
  external  
  : unique-key  ( -- n )  " unique-key" $call-parent  ;  
  headers  
  unique-key constant my-key  
  my-key encode-int  " write0-key" property  
  
  : xbox!  ( w offset -- )  my-key h# 18 << or or   write0-reg rl!  ;  

Code Example 8-3 Complete Hierarchical Device Driver (Continued)

  \ complete hierarchical device driver sample  
  : write-xac-ctl0  ( w -- )  xac-ctl0-offset xbox! ;  
  : write-xac-ctl1  ( w -- )  xac-ctl1-offset xbox! ;  
  : write-xbc-ctl0  ( w -- )  xbc-ctl0-offset xbox! ;  
  : write-xbc-ctl1  ( w -- )  xbc-ctl1-offset xbox! ;  
  
  \ Some functionally oriented words  
  
  : set-key        ( -- )  my-key 8 <<  xac-ctl0!  ;  
  : transparent    ( -- )             1 xac-ctl1!  ;  
  : opaque         ( -- )        0 write-xac-ctl1  ;  
  : enable-slaves  ( -- )    h# 38 write-xbc-ctl1  ;  
  
  : xbox-errors  ( -- xbc-err xac-err )  
     opaque  xbc-errd@ xac-errd@  transparent  
  ;  
  
  : ?.errors  ( xbc-err xac-err -- )  
     dup h# 8000.0000 and  if  
        cr .me  ." xac-error " .h cr  
     else  drop  
     then  
     dup h# 8000.0000 and  if  
        cr .me  ." xbc-error " .h cr  
     else drop  
     then  
  ;  
  
  \ The address space of the XBox in transparent mode may be dynamically  
  \ allocated across its plug-in slots.  This is called the  
  \ upper-address-decode-map (uadm).  Below is a table which relates the  
  \ slot configuration code which is programmed in hardware to the  
  \ allocation of address space for each slot.  The number in each cell is  
  \ the number of address bits needed for the slot.  
  
  decimal  
  create slot-sizes-array  
  \ slot0 slot1 slot2 slot3    slot-config  
    23 c, 23 c, 23 c, 23 c,     \ 00  
    23 c, 23 c, 23 c, 23 c,     \ 01  
    23 c, 23 c, 23 c, 23 c,     \ 02  
    23 c, 23 c, 23 c, 23 c,     \ 03  
    25 c,  0 c,  0 c,  0 c,     \ 04  
     0 c, 25 c,  0 c,  0 c,     \ 05  

Code Example 8-3 Complete Hierarchical Device Driver (Continued)

  \ complete hierarchical device driver sample  
     0 c,  0 c, 25 c,  0 c,     \ 06  
     0 c,  0 c,  0 c, 25 c,     \ 07  
    24 c, 24 c,  0 c,  0 c,     \ 08  
    24 c,  0 c, 24 c,  0 c,     \ 09  
     0 c, 24 c, 24 c,  0 c,     \ 0a  
     0 c,  0 c,  0 c,  0 c,     \ 0b  
    24 c, 23 c, 23 c,  0 c,     \ 0c  
    23 c, 24 c, 23 c,  0 c,     \ 0d  \ Overridden in code  
    23 c, 23 c, 24 c,  0 c,     \ 0e  \ Overridden in code  
    25 c,  0 c,  0 c,  0 c,     \ 0f  
    26 c, 26 c, 26 c, 26 c,     \ 10  
    26 c, 26 c, 26 c, 26 c,     \ 11  
    26 c, 26 c, 26 c, 26 c,     \ 12  
    26 c, 26 c, 26 c, 26 c,     \ 13  
    28 c,  0 c,  0 c,  0 c,     \ 14  
     0 c, 28 c,  0 c,  0 c,     \ 15  
     0 c,  0 c, 28 c,  0 c,     \ 16  
     0 c,  0 c,  0 c, 28 c,     \ 17  
    28 c, 28 c, 28 c, 28 c,     \ 18  
    28 c, 28 c, 28 c, 28 c,     \ 19  
    28 c, 28 c, 28 c, 28 c,     \ 1a  
    28 c, 28 c, 28 c, 28 c,     \ 1b  
     0 c,  0 c,  0 c,  0 c,     \ 1c  
     0 c,  0 c,  0 c,  0 c,     \ 1d  
     0 c,  0 c,  0 c,  0 c,     \ 1e  
     0 c,  0 c,  0 c,  0 c,     \ 1f  
  hex  
  
  20 constant /slot-sizes-array  
  -1 value slot-config  
  
  : >slot-size  ( slot# -- size )  
     slot-sizes-array  slot-config la+  swap ca+ c@  1 swap <<  
     1 not and         \ Could have slot size of 0.  
  ;  
  
  \ This array is to be filled with offsets for each slot.  
  \ Eg. 0, 100.0000, 180.0000, 200.0000  
  create host-offsets  0 , 0 , 0 , 0 ,  
  
  : >host-offset  ( child-slot# -- adr )  host-offsets swap na+ @  ;  
  
  create config-d-offsets  h# 100.0000 , 0           ,  h# 180.0000 ,  0 ,  

Code Example 8-3 Complete Hierarchical Device Driver (Continued)

  \ complete hierarchical device driver sample  
  create config-e-offsets  h# 100.0000 , h# 180.0000 ,  0           ,  0 ,  
  
  : set-host-offsets  ( -- )  
     slot-config  case  
        h# d of  config-d-offsets host-offsets 4 /n* move  exit  endof  
        h# e of  config-e-offsets host-offsets 4 /n* move  exit  endof  
     endcase  
     0                               ( initial-offset )  
     4 0  do                         ( offset )  
        dup host-offsets i na+ !     ( offset )  
        i >slot-size +               ( offset' )  
     loop                            ( final-offset )  
     drop  
  ;  
  
  : set-configuration  ( config-code -- )  
     is slot-config  
     set-host-offsets  
     slot-config 3 <<  my-key 8 << or  
     dup write-xac-ctl0                \ set XAC  
         write-xbc-ctl0                \ set XBC  
     slot-config encode-int  " uadm" property    \ publish slot configuration  
  ;  
  
  \ Required package methods  
  
  external  
  
  : dma-alloc   ( #bytes -- )                      " dma-alloc" $call-parent  ;  
  : dma-free    ( #bytes -- )                      " dma-free" $call-parent  ;  
  : dma-map-in  ( vaddr #bytes cache? -- devaddr ) " dma-map-in" $call-parent  ;  
  : dma-map-out ( vaddr devaddr #bytes -- )        " dma-map-out" $call-parent  ;  
  : dma-sync    ( virt devaddr #bytes -- )         " dma-sync" $call-parent  ;  
  
  : map-in  ( offset slot# size -- virtual )  
     >r                             ( offset xbox-slot# )  
     >host-offset +  my-space       ( parent-offset parent-slot# )  
     r>  " map-in" $call-parent     ( virtual )  
  ;  
  
  : map-out  ( virt size -- )  " map-out" $call-parent  ;  
  
  : decode-unit   ( adr len -- address space )  

Code Example 8-3 Complete Hierarchical Device Driver (Continued)

  \ complete hierarchical device driver sample  
     decode-2int                                    ( offset slot# )  
     dup 0 3 between 0=  if  
        ." Invalid XBox slot number " .d cr  
        1 abort  
     then                                           ( offset slot# )  
  ;  
  
  \ Hack because set-args and byte-load are not FCodes  
  : byte-load  ( adr len -- )          " byte-load" $find drop execute  ;  
  : set-args   ( adr len adr len -- )  " set-args"  $find drop execute  ;  
  
  : probe-self  ( arg-adr arg-len reg-adr reg-len fcode-adr fcode-len -- )  
  
     ['] decode-unit catch  if  
        2drop 2drop 2drop 2drop  
        exit  
     then                                     ( arg-str reg-str fcode-offs,space )  
  
     h# 10000 map-in                          ( arg-str reg-str fcode-vaddr )  
  
     dup cpeek  if                            ( arg-str reg-str fcode-vaddr byte )  
        dup h# f0 =  swap h# fd =  or  if     ( arg-str reg-str fcode-vaddr )  
           new-device                         ( arg-str reg-str fcode-vaddr )  
              >r  set-args r>                 ( fcode-vaddr )  
              dup 1 byte-load                 ( fcode-vaddr )  
           finish-device  
        else                                  ( arg-str reg-str fcode-vaddr )  
           nip nip nip nip                    ( fcode-vaddr )  
           ." Invalid FCode start byte in " .me cr  
        then                                  ( fcode-vaddr )  
     else                                     ( arg-str reg-str fcode-vaddr )  
        nip nip nip nip                       ( fcode-vaddr )  
     then  
  
     h# 10000 map-out  
  ;  
  
  : open  ( -- ok? )  true ;  
  : close  ( -- ) ;  
  
  headers  
  
  \ The XBox slot configuration may be forced by the user. The mechanism  

Code Example 8-3 Complete Hierarchical Device Driver (Continued)

  \ complete hierarchical device driver sample  
  \ for doing this is a string which specifies megs/slot (eg. "16,8,8,0").  
  
  \ This string is processed into the config bits array.  Then the  
  \ slot-sizes-array is searched for a configuration which matches or  
  \ exceeds the requested number for each slot.  If the request is  
  \ unreasonable the default-slot-config is used.  
  \ Then the configuration is set in the XBox hardware.  
  \ Finally each slot is probed based on the config.  
  
  : default-slot-config  ( -- n )  
     host-slot-size  d# 25 = if  
        h# c                   \ 1x24 bits, 2x23 bits  
     else  h# 10               \ 4x26 bits  
     then  
  ;  
  
  \ This array to be filled with bit sizes for each slot.  
  \ Eg. 24, 23, 23, 0  
  create config-bits  0 c, 0 c, 0 c, 0 c,  
  
  : config-ok?  ( config -- ok? )  
     true  
     slot-sizes-array rot 4 * ca+     ( ok? slot-adr )  
     4 0 do  
        config-bits i ca+  c@  
        over i ca+  c@                ( ok? slot-adr conf-bits slot-bits )  
        > if  
           nip false swap  leave  
        then  
     loop  
     drop  
  ;  
  
  : fit-config  ( -- config )  
     default-slot-config  
     /slot-sizes-array  0 do  
        i config-ok? if  
           drop i leave  
        then  
     loop  
  ;  
  
  : megs>bits  ( megs -- bits )      \ Convert requested megs to # of address bits  

Code Example 8-3 Complete Hierarchical Device Driver (Continued)

  \ complete hierarchical device driver sample  
     ?dup      0= if           0  exit  then  
     dup      9 < if  drop d# 23  exit  then  
     dup d#  17 < if  drop d# 24  exit  then  
     dup d#  33 < if  drop d# 25  exit  then  
     dup d#  65 < if  drop d# 26  exit  then  
     dup d# 129 < if  drop d# 27  exit  then  
         d# 257 < if       d# 28  exit  then  
     d# 29                      \ d#29 is too many bits => error  
  ;  
  
  : request-megs  ( adr len -- )      \ Fill config-bits table  
     base @ >r  decimal  
     4 0 do  
        ascii , left-parse-string  
        $number  0= if  
           megs>bits  config-bits i ca+ c!  
        then  
     loop  
     2drop  
     r> base !  
  ;  
  
  : find-config  ( adr len -- config )  
     request-megs  fit-config  
  ;  
  
  create slot-string  ascii # c, ascii , c,  ascii 0 c,  
  
  : probe-slot  ( slot# -- )  
     dup >slot-size 0=  if  drop exit  then   ( slot# )  
     ascii 0 +  slot-string c!  
     " " slot-string 3                  ( arg-str reg-str )  
     2dup                               ( arg-str reg-str fcode-str )  
     probe-self  
  ;  
  
  : probe-children  ( -- )  
     4 0  do  
        config-bits i ca+ c@  if  
           i probe-slot  
        then  
     loop  
  ;  

Code Example 8-3 Complete Hierarchical Device Driver (Continued)

  \ complete hierarchical device driver sample  
  
  : forced-configuration  ( adr len  -- )  
     find-config          ( config-code )  
     set-configuration  
     probe-children  
  ;  
  
  \ The Xbox slot configuration may be autoconfigured by the driver.  The  
  \ autoconfiguration mechanism uses the following state transition table.  
  \ The table basically loops through each XBox slot with a current guess  
  \ at the slot config.  With each slot the code then probes the slot's  
  \ FCode and uses the reg property information of the slot's new device  
  \ node to determine the amount of address space required by the slot.  
  \ The slot config guess is updated and a state transition is made.  
  
  \ This is the state transition table.  Each entry in the table consists  
  \ of 16 bits.  The most significant 8 bits is the XBox configuration  
  \ code for the next state, and the least 8 bits is the next state.  
  
  create states  
  \ Empty     min      mid  
  \ Empty     23       24        for 25 bit host SBus slot  
    0501 w,  0d04 w,  0803 w,  \ 0                         testing slot 0  
    0602 w,  0a05 w,  0a0f w,  \ 1  Slot 0 empty,          testing slot 1  
    0706 w,  000f w,  060e w,  \ 2  Slots 0,1 empty,       testing slot 2  
    090f w,  0c0f w,  080e w,  \ 3  Slot 0 is 24 bit,      testing slot 1  
    0e05 w,  0e05 w,  0d0f w,  \ 4  Slot 0 23 bit,         testing slot 1  
    000f w,  000f w,  0e0e w,  \ 5  Slot 0 empty and Slot1 23 bit,  
                               \ or Slot 0,1 are 23 bit    testing slot 2  
    0c0e w,  070e w,  070e w,  \ 6  Slots 0,1,2 empty,     testing slot 3  
  \ Empty    notused   26      for 28 bit host SBus slot  
    1508 w,  100e w,  100b w,  \ 7                         testing slot 0  
    1609 w,  100e w,  100c w,  \ 8  Slot  0 empty,         testing slot 1  
    170a w,  100e w,  100d w,  \ 9  Slots 0,1 empty,       testing slot 2  
    100e w,  100e w,  170e w,  \ a  Slots 0,1,2 empty,     testing slot 3  
    100c w,  100e w,  100c w,  \ b  Slot 0 is 26 bit,      testing slot 1  
    100d w,  100e w,  100d w,  \ c  Slots 0,1 are 26 bit,  testing slot 2  
    100e w,  100e w,  100e w,  \ d  Slots 0,1,2 are 26 bit,testing slot 3  
                               \ e  
                               \ f  
  0           value slot#  
  0           value start-state         \ for auto-config state machine  

Code Example 8-3 Complete Hierarchical Device Driver (Continued)

  \ complete hierarchical device driver sample  
  4           value start-config  
  h# 100.0000 value max-card            \ 25 bit default  
  h# 080.0000 value mid-card            \ 25 bit default  
  
  : configure25  ( -- )                 \ 25 bit host SBus slots  
     0           is start-state  
     4           is start-config  
     h# 100.0000 is max-card            \ 25 bits for one Xbox slot  
     h# 080.0000 is mid-card            \ 24 bits per XBox slot  
  ;  
  : configure28  ( -- )                 \ 28 bit host SBus slots  
     7           is start-state  
     h# 14       is start-config  
     h# 800.0000 is max-card            \ 28 bits for one XBox slot  
     h# 0        is mid-card            \ 26 bits per Xbox slot  
  ;  
  
  0 value child-node  
  
  \ Since child and peer do not appear until 2.3,  
  \ we include the following workarounds.  
  : next-peer  ( phandle -- phandle' )  
     fcode-version 2.0003 >=  if  
        peer  
     else  
        " romvec" $find drop execute   1c + @  0 + @  
        " call"   $find drop execute   nip  
     then  
  ;  
  : first-child  ( phandle -- phandle' )  
     fcode-version 2.0003 >=  if  
        child  
     else  
        " romvec" $find drop execute   1c + @  4 + @  
        " call"   $find drop execute   nip  
     then  
  ;  
  
  0 value extent            \ 1 if card exists, but no reg prop or 0 reg  
  
  : bump-extent  ( n -- )   extent max  is extent ;  

Code Example 8-3 Complete Hierarchical Device Driver (Continued)

  \ complete hierarchical device driver sample  
  : max-reg-extent  ( adr len -- )  
     begin  dup  while  
        decode-int drop decode-int >r   decode-int r> +   ( adr' len' extent)  
        bump-extent  
     repeat  
     2drop  
     extent 0=  if            \ reg prop is 0 -- fake it  
        1 bump-extent  
     then  
  ;  
  
  : find-extent  ( -- )  
     0 is extent  
     begin  
        child-node  if  
           child-node next-peer  
        else  
           my-self ihandle>phandle first-child  
        then                    ( next-child )  
     ?dup while  
        is child-node  
        " reg" child-node get-package-property  0=  if  ( adr len )  
           max-reg-extent  
        else                  \ card has no reg prop -- fake it  
           1 bump-extent  
        then  
     repeat  
  ;  
  
  : evaluate-size  ( -- size-code )  
     find-extent  
     extent  slot# >slot-size >  if  
        ." The card in slot "  slot# .  
        ." of "  .me  
        ." uses too much address space." cr  
        abort  
     then  
     extent                                 ( max-extent )  
     dup max-card > if  drop 3  exit  then  ( max-extent )  \ max-size card  
     dup mid-card > if  drop 2  exit  then  ( max-extent )  \ mid-size card?  
                0 > if       1  exit  then  ( )             \ 25-small card?  
     0                                                      \ null for 28  
  ;  

Code Example 8-3 Complete Hierarchical Device Driver (Continued)

  \ complete hierarchical device driver sample  
  
  : test-slot  ( xbox-config -- size-code )  
     set-configuration    ( )  
     slot# probe-slot     ( )  
     evaluate-size        ( size-code )  
  ;  
  
  : autoconfigure  ( -- )  
     0  is child-node  
     -1 is slot#  
  
     host-slot-size d# 25 =  if  configure25   else  configure28  then  
  
     start-state  start-config                    ( state# xbox-config )  
     begin                                        ( state# xbox-config )  
        slot# 1+ is slot#  test-slot              ( state# size-code )  
        dup 3 =      if  2drop  exit  then        ( state# size-code )  
        over h# f =  if  2drop  exit  then        ( state# size-code )  
        states  rot 3 * wa+  swap wa+  w@ wbsplit ( state#' xbox-config' )  
     over h# e =  until                           ( state#' xbox-config' )  
  
     2drop  
  ;  
  
  \ Initialize the XBox H/W.  If the XAdaptor H/W detects that XBox  
  \ Expansion H/W is connected and powered-up it puts the H/W into  
  \ transparent mode and sets the XBox slot configuraton based on either a  
  \ forced configruation or the autoconfiguration algorithm.  
  
  : configuration  ( -- )  
     " xbox-slot-config" get-inherited-property  0=  if  
        decodestring     ( adr len adr len )  
        find-config forced-configuration  
        2drop  
     else  
        2drop  
        autoconfigure  
     then  
  ;  
  
  : null-xdr  ( -- adr len )  
     fcode-version 2.0001 >=  if  
        0 0 encodebytes  

Code Example 8-3 Complete Hierarchical Device Driver (Continued)

  \ complete hierarchical device driver sample  
     else  
        here 0  
     then  
  ;  
  
  : make-ranges  ( -- )  
     null-xdr                                    ( adr len )  
     4 0  do  
        i >slot-size  if                         ( adr len )  
        0               i         encode-phys encode+   ( adr len )  
        i >host-offset  my-space  encode-phys encode+   ( adr len )  
           i >slot-size           encode-int  encode+   ( adr len )  
        then  
     loop  
     " ranges" property  
  ;  
  
  \ Because we go transparent in the middle and therefore the fcode prom  
  \ disappears the following must be in a definition.  
  
  : init-pkg  ( -- )  
     map-regs  
     set-key                   \ opaque already  
     xac-errs@ h# 40 and  if   \ Child ready?  
        transparent            \ Go transparent, then enable-slaves  
        enable-slaves  
        configuration  
        make-ranges  
        xbox-errors  
        ?.errors  
        " true"  
     else  
        cr .me  
        ." child not ready --"  cr  
        ." perhaps the cable is not plugged in"  cr  
        ." or the expansion box is not turned on."  cr  
        " false"  
     then                        ( adr len )  
     encodestring  " child-present"  property  
     unmap-regs  
     ['] end0 execute  
  ;  

Code Example 8-3 Complete Hierarchical Device Driver (Continued)

  \ complete hierarchical device driver sample  
  init-pkg  
  
  end0