← Back to branch summary

~pmdj/ubuntu/trusty/qemu/2.9+applesmc+fadtv3

« back to all changes in this revision

Viewing changes to roms/SLOF/board-js2x/slof/citrine-disk.fs

  • Committer: Phil Dennis-Jordan
  • Date: 2017-07-21 08:03:43 UTC
  • mfrom: (1.1.1)
  • Revision ID: phil@philjordan.eu-20170721080343-2yr2vdj7713czahv
New upstream release 2.9.0.

Show diffs side-by-side

added added

removed removed

Lines of Context:
roms/SLOF/board-js2x/slof/citrine-disk.fs
 
1
\ *****************************************************************************
 
2
\ * Copyright (c) 2004, 2008 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
 
 
14
( max-#blocks rsrc id -- )
 
15
 
 
16
new-device   
 
17
 
 
18
lwsplit swap wbsplit rot set-unit
 
19
 
 
20
s" disk" device-name  s" block" device-type
 
21
 
 
22
CONSTANT resource-id
 
23
CONSTANT max-#blocks
 
24
get-parent CONSTANT ppack
 
25
 
 
26
 
 
27
: our-disk-read ( lba count addr -- )
 
28
  >r >r >r resource-id r> r> r> s" do-read" ppack $call-static ;
 
29
 
 
30
0 pci-alias-disk
 
31
 
 
32
\ Requiered interface for deblocker
 
33
 
 
34
200   CONSTANT block-size
 
35
40000 CONSTANT max-transfer 
 
36
 
 
37
: read-blocks ( addr block# #blocks -- #read )
 
38
\   my-unit s" dev-read-blocks" $call-parent
 
39
   \ check if the read is within max-#blocks
 
40
   2dup + max-#blocks 1 + > IF 
 
41
     \ 2drop drop 0 \ return 0 
 
42
     \ returning 0 would be correct (maybe?) but it confuses the deblocker...
 
43
     \ so i erase whatever would have been read and return the "expected" #read
 
44
     dup >r 
 
45
     swap drop \ drop block# (not needed)
 
46
     block-size * erase \ erase at addr #blocks * block-size
 
47
     r>   \ return #read 
 
48
   ELSE
 
49
     dup >r rot our-disk-read r>
 
50
   THEN
 
51
;    
 
52
 
 
53
INSTANCE VARIABLE deblocker
 
54
 
 
55
: open ( -- okay? )
 
56
   0 0 s" deblocker" $open-package dup deblocker ! dup IF 
 
57
      s" disk-label" find-package IF
 
58
         my-args rot interpose
 
59
      THEN
 
60
   THEN 0<> ;
 
61
 
 
62
: close ( -- )
 
63
   deblocker @ close-package ;
 
64
 
 
65
: seek ( pos.lo pos.hi -- status )
 
66
   2dup lxjoin max-#blocks 1 + block-size *  > IF 
 
67
     \ illegal seek, return -1
 
68
     2drop -1
 
69
   ELSE
 
70
     s" seek" deblocker @ $call-method
 
71
   THEN
 
72
;
 
73
 
 
74
: read ( addr len -- actual )
 
75
   s" read" deblocker @ $call-method ;
 
76
 
 
77
 
 
78
finish-device
 
79