|
|
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
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.