summaryrefslogtreecommitdiffstats
path: root/qemu/roms/SLOF/slof/fs/packages/fat-files.fs
blob: 0cec3664ed31f33128ca7cb3557e58862a885a6c (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
\ *****************************************************************************
\ * Copyright (c) 2004, 2008 IBM Corporation
\ * All rights reserved.
\ * This program and the accompanying materials
\ * are made available under the terms of the BSD License
\ * which accompanies this distribution, and is available at
\ * http://www.opensource.org/licenses/bsd-license.php
\ *
\ * Contributors:
\ *     IBM Corporation - initial implementation
\ ****************************************************************************/


s" fat-files" device-name

INSTANCE VARIABLE bytes/sector
INSTANCE VARIABLE sectors/cluster
INSTANCE VARIABLE #reserved-sectors
INSTANCE VARIABLE #fats
INSTANCE VARIABLE #root-entries
INSTANCE VARIABLE total-#sectors
INSTANCE VARIABLE media-descriptor
INSTANCE VARIABLE sectors/fat
INSTANCE VARIABLE sectors/track
INSTANCE VARIABLE #heads
INSTANCE VARIABLE #hidden-sectors

INSTANCE VARIABLE fat-type
INSTANCE VARIABLE bytes/cluster
INSTANCE VARIABLE fat-offset
INSTANCE VARIABLE root-offset
INSTANCE VARIABLE cluster-offset
INSTANCE VARIABLE #clusters

: seek  s" seek" $call-parent ;
: read  s" read" $call-parent ;

INSTANCE VARIABLE data
INSTANCE VARIABLE #data

: free-data
  data @ ?dup IF #data @ free-mem  0 data ! THEN ;
: read-data ( offset size -- )
  free-data  dup #data ! alloc-mem data !
  xlsplit seek            -2 and ABORT" fat-files read-data: seek failed"
  data @ #data @ read #data @ <> ABORT" fat-files read-data: read failed" ;

CREATE fat-buf 8 allot
: read-fat ( cluster# -- data )
  fat-buf 8 erase
  1 #split fat-type @ * 2/ 2/ fat-offset @ +
  xlsplit seek -2 and ABORT" fat-files read-fat: seek failed"
  fat-buf 8 read 8 <> ABORT" fat-files read-fat: read failed"
  fat-buf 8c@ bxjoin fat-type @ dup >r 2* #split drop r> #split
  rot IF swap THEN drop ;
  
INSTANCE VARIABLE next-cluster

: read-cluster ( cluster# -- )
  dup bytes/cluster @ * cluster-offset @ + bytes/cluster @ read-data
  read-fat dup #clusters @ >= IF drop 0 THEN next-cluster ! ;
: read-dir ( cluster# -- )
  ?dup 0= IF root-offset @ #root-entries @ 20 * read-data 0 next-cluster !
  ELSE read-cluster THEN ;

: .time ( x -- )
  base @ >r decimal
  b #split 2 0.r [char] : emit  5 #split 2 0.r [char] : emit  2* 2 0.r
  r> base ! ;
: .date ( x -- )
  base @ >r decimal
  9 #split 7bc + 4 0.r [char] - emit  5 #split 2 0.r [char] - emit  2 0.r
  r> base ! ;
: .attr ( attr -- )
  6 0 DO dup 1 and IF s" RHSLDA" drop i + c@ ELSE bl THEN emit u2/ LOOP drop ;
: .dir-entry ( adr -- )
  dup 0b + c@ 8 and IF drop EXIT THEN \ volume label, not a file
  dup c@ e5 = IF drop EXIT THEN \ deleted file
  cr
  dup 1a + 2c@ bwjoin [char] # emit 4 0.r space \ starting cluster
  dup 18 + 2c@ bwjoin .date space
  dup 16 + 2c@ bwjoin .time space
  dup 1c + 4c@ bljoin base @ decimal swap a .r base ! space \ size in bytes
  dup 0b + c@ .attr space
  dup 8 BEGIN 2dup 1- + c@ 20 = over and WHILE 1- REPEAT type
  dup 8 + 3 BEGIN 2dup 1- + c@ 20 = over and WHILE 1- REPEAT dup IF
  [char] . emit type ELSE 2drop THEN
  drop ;
: .dir-entries ( adr n -- )
  0 ?DO dup i 20 * + dup c@ 0= IF drop LEAVE THEN .dir-entry LOOP drop ;
: .dir ( cluster# -- )
  read-dir BEGIN data @ #data @ 20 / .dir-entries next-cluster @ WHILE
  next-cluster @ read-cluster REPEAT ;

: str-upper ( str len adr -- ) \ Copy string to adr, uppercase
  -rot bounds ?DO i c@ upc over c! char+ LOOP drop ;
CREATE dos-name b allot
: make-dos-name ( str len -- )
  dos-name b bl fill
  2dup [char] . findchar IF
  3dup 1+ /string 3 min dos-name 8 + str-upper nip THEN
  8 min dos-name str-upper ;

: (find-file) ( -- cluster file-len is-dir? true | false )
  data @ BEGIN dup data @ #data @ + < WHILE
  dup dos-name b comp WHILE 20 + REPEAT
  dup 1a + 2c@ bwjoin swap dup 1c + 4c@ bljoin swap 0b + c@ 10 and 0<> true
  ELSE drop false THEN ;
: find-file ( dir-cluster name len -- cluster file-len is-dir? true | false )
  make-dos-name read-dir BEGIN (find-file) 0= WHILE next-cluster @ WHILE
  next-cluster @ read-cluster REPEAT false ELSE true THEN ;
: find-path ( dir-cluster name len -- cluster file-len true | false )
  dup 0= IF 3drop false ."  empty name " EXIT THEN
  over c@ [char] \ = IF 1 /string  RECURSE EXIT THEN
  [char] \ split 2>r find-file 0= IF 2r> 2drop false ."  not found " EXIT THEN
  r@ 0<> <> IF 2drop 2r> 2drop false ."  no dir<->file match " EXIT THEN
  r@ 0<> IF drop 2r> RECURSE EXIT THEN
  2r> 2drop true ;
  
: do-super ( -- )
  0 200 read-data
  data @ 0b + 2c@ bwjoin bytes/sector !
  data @ 0d + c@ sectors/cluster !
  bytes/sector @ sectors/cluster @ * bytes/cluster !
  data @ 0e + 2c@ bwjoin #reserved-sectors !
  data @ 10 + c@ #fats !
  data @ 11 + 2c@ bwjoin #root-entries !
  data @ 13 + 2c@ bwjoin total-#sectors !
  data @ 15 + c@ media-descriptor !
  data @ 16 + 2c@ bwjoin sectors/fat !
  data @ 18 + 2c@ bwjoin sectors/track !
  data @ 1a + 2c@ bwjoin #heads !
  data @ 1c + 2c@ bwjoin #hidden-sectors !

  \ For FAT16 and FAT32:
  total-#sectors @ 0= IF data @ 20 + 4c@ bljoin total-#sectors ! THEN

  \ For FAT32:
  sectors/fat @ 0= IF data @ 24 + 4c@ bljoin sectors/fat ! THEN

  \ XXX add other FAT32 stuff (offsets 28, 2c, 30)

  \ Compute the number of data clusters, decide what FAT type we are.
  total-#sectors @ #reserved-sectors @ - sectors/fat @ #fats @ * -
  #root-entries @ 20 * bytes/sector @ // - sectors/cluster @ /
  dup #clusters !
  dup ff5 < IF drop c ELSE fff5 < IF 10 ELSE 20 THEN THEN fat-type !
  base @ decimal base !

  \ Starting offset of first fat.
  #reserved-sectors @ bytes/sector @ * fat-offset !

  \ Starting offset of root dir.
  #fats @ sectors/fat @ * bytes/sector @ * fat-offset @ + root-offset !

  \ Starting offset of "cluster 0".
  #root-entries @ 20 * bytes/sector @ tuck // * root-offset @ +
  bytes/cluster @ 2* - cluster-offset ! ;


INSTANCE VARIABLE file-cluster
INSTANCE VARIABLE file-len
INSTANCE VARIABLE current-pos
INSTANCE VARIABLE pos-in-data

: seek ( lo hi -- status )
  lxjoin dup current-pos ! file-cluster @ read-cluster
  \ Read and skip blocks until we are where we want to be.
  BEGIN dup #data @ >= WHILE #data @ - next-cluster @ dup 0= IF
  2drop true EXIT THEN read-cluster REPEAT pos-in-data ! false ;
: read ( adr len -- actual )
  file-len @ current-pos @ - min \ can't go past end of file
  #data @ pos-in-data @ - min >r \ length for this transfer
  data @ pos-in-data @ + swap r@ move \ move the data
  r@ pos-in-data +!  r@ current-pos +!  pos-in-data @ #data @ = IF
  next-cluster @ ?dup IF read-cluster 0 pos-in-data ! THEN THEN r> ;
: read ( adr len -- actual )
  file-len @ min                \ len cannot be greater than file size
  dup >r BEGIN dup WHILE 2dup read dup 0= ABORT" fat-files: read failed"
  /string ( tuck - >r + r> ) REPEAT 2drop r> ;
: load ( adr -- len )
  file-len @ read dup file-len @ <> ABORT" fat-files: failed loading file" ;

: close  free-data ;
: open
  do-super
  0 my-args find-path 0= IF close false EXIT THEN
  file-len !  file-cluster !  0 0 seek 0= ;