Annotation of qemu/roms/SLOF/board-qemu/slof/vio-vscsi-device.fs, revision 1.1

1.1     ! root        1: \ *****************************************************************************
        !             2: \ * Copyright (c) 2011 IBM Corporation
        !             3: \ * All rights reserved.
        !             4: \ * This program and the accompanying materials
        !             5: \ * are made available under the terms of the BSD License
        !             6: \ * which accompanies this distribution, and is available at
        !             7: \ * http://www.opensource.org/licenses/bsd-license.php
        !             8: \ *
        !             9: \ * Contributors:
        !            10: \ *     IBM Corporation - initial implementation
        !            11: \ ****************************************************************************/
        !            12: 
        !            13: \ Create new VSCSI child device
        !            14: \ ( lun id $name is_cdrom -- )
        !            15: 
        !            16: \ Create device
        !            17: new-device
        !            18: 
        !            19: VALUE is_cdrom
        !            20: 
        !            21: 2swap  ( $name lun id )
        !            22: 
        !            23: \ Set reg & unit
        !            24: 2dup set-unit encode-phys " reg" property
        !            25: 
        !            26: \ Set name
        !            27: 2dup device-name
        !            28: 
        !            29: 2dup find-alias 0= IF
        !            30:     get-node node>path set-alias
        !            31: ELSE 2drop THEN 
        !            32: 
        !            33: s" block" device-type      
        !            34: 
        !            35: \ Required interface for deblocker
        !            36: 
        !            37: 0 INSTANCE VALUE block-size
        !            38: 0 INSTANCE VALUE max-block-num
        !            39: 0 INSTANCE VALUE max-transfer
        !            40: 
        !            41: : read-blocks ( addr block# #blocks -- #read )
        !            42:     block-size " dev-read-blocks" $call-parent
        !            43:     not IF
        !            44:         ." Read blocks failed !" cr -1 throw
        !            45:     THEN
        !            46: ;    
        !            47: 
        !            48: INSTANCE VARIABLE deblocker
        !            49: 
        !            50: : open ( -- true | false )
        !            51:     my-unit " set-address" $call-parent
        !            52:     is_cdrom IF " dev-prep-cdrom" ELSE " dev-prep-disk" THEN $call-parent
        !            53:     " dev-get-capacity" $call-parent to max-block-num to block-size
        !            54:     " dev-max-transfer" $call-parent to max-transfer
        !            55: 
        !            56:     0 0 " deblocker" $open-package dup deblocker ! dup IF 
        !            57:         " disk-label" find-package IF
        !            58:            my-args rot interpose
        !            59:         THEN
        !            60:    THEN 0<>
        !            61: ;
        !            62: 
        !            63: : close ( -- )
        !            64:     deblocker @ close-package ;
        !            65: 
        !            66: : seek ( pos.lo pos.hi -- status )
        !            67:     s" seek" deblocker @ $call-method ;
        !            68: 
        !            69: : read ( addr len -- actual )
        !            70:     s" read" deblocker @ $call-method ;
        !            71: 
        !            72: finish-device

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.