xref: /titanic_50/usr/src/psm/stand/bootblks/ufs/common/ufs.fth (revision c713350eb0c205161e2a4ab06cd996300721ac78)
1986fd29aSsetje\
2986fd29aSsetje\ CDDL HEADER START
3986fd29aSsetje\
4986fd29aSsetje\ The contents of this file are subject to the terms of the
5986fd29aSsetje\ Common Development and Distribution License (the "License").
6986fd29aSsetje\ You may not use this file except in compliance with the License.
7986fd29aSsetje\
8986fd29aSsetje\ You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
9986fd29aSsetje\ or http://www.opensolaris.org/os/licensing.
10986fd29aSsetje\ See the License for the specific language governing permissions
11986fd29aSsetje\ and limitations under the License.
12986fd29aSsetje\
13986fd29aSsetje\ When distributing Covered Code, include this CDDL HEADER in each
14986fd29aSsetje\ file and include the License file at usr/src/OPENSOLARIS.LICENSE.
15986fd29aSsetje\ If applicable, add the following below this CDDL HEADER, with the
16986fd29aSsetje\ fields enclosed by brackets "[]" replaced with your own identifying
17986fd29aSsetje\ information: Portions Copyright [yyyy] [name of copyright owner]
18986fd29aSsetje\
19986fd29aSsetje\ CDDL HEADER END
20986fd29aSsetje\
21986fd29aSsetje\
22*c713350eSJohn Johnson\ Copyright 2009 Sun Microsystems, Inc.  All rights reserved.
23*c713350eSJohn Johnson\ Use is subject to license terms.
24*c713350eSJohn Johnson\
25986fd29aSsetje
26986fd29aSsetje
27986fd29aSsetjepurpose: UFS file system support package
28*c713350eSJohn Johnsoncopyright: Copyright 2009 Sun Microsystems, Inc. All Rights Reserved
29986fd29aSsetje
30986fd29aSsetjeheaders
31986fd29aSsetje" /packages" get-package  push-package
32986fd29aSsetje
33986fd29aSsetjenew-device
34986fd29aSsetje   fs-pkg$  device-name  diag-cr?
35986fd29aSsetje
36986fd29aSsetje   \
37986fd29aSsetje   \	UFS low-level block routines
38986fd29aSsetje   \
39986fd29aSsetje
40986fd29aSsetje   h# 2000  constant  /max-bsize
41986fd29aSsetje   d# 512   constant  /disk-block
42986fd29aSsetje
43986fd29aSsetje   0 instance value dev-ih
44986fd29aSsetje   0 instance value temp-block
45986fd29aSsetje
46986fd29aSsetje   : blk>byte ( block# -- byte# )  /disk-block *  ;
47986fd29aSsetje
48986fd29aSsetje   : read-disk-blocks  ( adr len dev-block# -- )
49986fd29aSsetje      blk>byte dev-ih  read-disk
50986fd29aSsetje   ;
51986fd29aSsetje
52986fd29aSsetje
53986fd29aSsetje   \
54986fd29aSsetje   \	UFS superblock routines
55986fd29aSsetje   \
56986fd29aSsetje
57986fd29aSsetje   d# 512 constant /super-block
58986fd29aSsetje   d#  16 constant super-block#
59986fd29aSsetje   0 instance value super-block
60986fd29aSsetje
61986fd29aSsetje   : +sb  ( index -- value )  super-block  swap la+ l@  ;
62986fd29aSsetje   : iblkno    ( -- n )  d# 04 +sb  ;
63986fd29aSsetje   : cgoffset  ( -- n )  d# 06 +sb  ;
64986fd29aSsetje   : cgmask    ( -- n )  d# 07 +sb  ;
65986fd29aSsetje   : bsize     ( -- n )  d# 12 +sb  ;
66986fd29aSsetje   : fragshift ( -- n )  d# 24 +sb  ;
67986fd29aSsetje   : fsbtodbc  ( -- n )  d# 25 +sb  ;
68986fd29aSsetje   : inopb     ( -- n )  d# 30 +sb  ;
69986fd29aSsetje   : ipg       ( -- n )  d# 46 +sb  ;
70986fd29aSsetje   : fpg       ( -- n )  d# 47 +sb  ;
71986fd29aSsetje
72986fd29aSsetje   : /frag  ( -- fragsize )  bsize fragshift rshift ;
73986fd29aSsetje
74986fd29aSsetje   : get-super-block  ( -- )
75986fd29aSsetje      super-block /super-block super-block#  read-disk-blocks
76986fd29aSsetje   ;
77986fd29aSsetje
78986fd29aSsetje   : cgstart   ( cg -- block# )
79986fd29aSsetje      dup cgmask invert and  cgoffset *   swap fpg *  +
80986fd29aSsetje   ;
81986fd29aSsetje   : cgimin       ( cg -- block# )  cgstart  iblkno +  ;
82986fd29aSsetje   : blkstofrags  ( #blocks -- #frags )  fragshift lshift  ;
83986fd29aSsetje   : lblkno       ( byte-off -- lblk# )  bsize /  ;
84986fd29aSsetje   : blkoff       ( byte-off -- blk-off )  bsize mod  ;
85986fd29aSsetje   : fsbtodb      ( fs-blk# -- dev-blk# )  fsbtodbc lshift  ;
86986fd29aSsetje
87986fd29aSsetje   : read-fs-blocks  ( adr len fs-blk# -- )  fsbtodb read-disk-blocks  ;
88986fd29aSsetje
89986fd29aSsetje
90986fd29aSsetje   \
91986fd29aSsetje   \	UFS inode routines
92986fd29aSsetje   \
93986fd29aSsetje
94986fd29aSsetje   h# 80 constant /inode
95986fd29aSsetje   0 instance value inode
96986fd29aSsetje   0 instance value iptr
97986fd29aSsetje
98986fd29aSsetje   : itoo  ( i# -- offset )  inopb mod  ;
99986fd29aSsetje   : itog  ( i# -- group )  ipg /  ;
100986fd29aSsetje   : itod  ( i# -- block# )
101986fd29aSsetje      dup itog cgimin  swap ipg mod  inopb /  blkstofrags  +
102986fd29aSsetje   ;
103986fd29aSsetje
104986fd29aSsetje   : +i  ( n -- adr )  iptr +  ;
105986fd29aSsetje
106986fd29aSsetje   : ftype ( -- n )  0 +i  w@  h# f000 and  ;
107986fd29aSsetje   : dir?      ( -- flag )  ftype h# 4000 =  ;
108986fd29aSsetje   : symlink?  ( -- flag )  ftype h# a000 =  ;
109986fd29aSsetje   : regular?  ( -- flag )  ftype h# 8000 =  ;
110986fd29aSsetje
111986fd29aSsetje   : file-size  ( -- n )        8 +i x@  ;
112986fd29aSsetje   : direct0    ( -- adr )  d# 40 +i  ;
113986fd29aSsetje   : indirect0  ( -- adr )  d# 88 +i  ;
114986fd29aSsetje   : indirect1  ( -- adr )  d# 92 +i  ;
115986fd29aSsetje   : indirect2  ( -- adr )  d# 96 +i  ;
116986fd29aSsetje   : comp?      ( -- flag ) d# 100 +i l@  4 and  0<> ;
117986fd29aSsetje
118986fd29aSsetje   0 instance value current-file
119986fd29aSsetje   : iget  ( i# -- )
120986fd29aSsetje      dup temp-block bsize  rot  itod        ( i# adr len blk# )
121986fd29aSsetje      read-fs-blocks
122986fd29aSsetje      dup itoo  /inode *  temp-block +  inode /inode  move
123986fd29aSsetje      inode to iptr
124986fd29aSsetje      to current-file                        (  )
125986fd29aSsetje   ;
126986fd29aSsetje
127986fd29aSsetje   : l@++  ( ptr -- value )  dup @ l@  /l rot +!  ;
128986fd29aSsetje
129986fd29aSsetje   d# 12 constant #direct
130986fd29aSsetje   : #blk-addr/blk  bsize /l /  ;
131986fd29aSsetje   : #sgl-addr      #blk-addr/blk  ;
132986fd29aSsetje   : #dbl-addr      #sgl-addr #blk-addr/blk *  ;
133986fd29aSsetje\  : #tri-addr      #dbl-addr #blk-addr/blk *  ;
134986fd29aSsetje
135986fd29aSsetje   : >1-idx ( blk# -- idx )  #blk-addr/blk mod  ;
136986fd29aSsetje   : >2-idx ( blk# -- idx )  #sgl-addr /  >1-idx  ;
137986fd29aSsetje\  : >3-idx ( blk# -- idx )  #dbl-addr /  >1-idx  ;
138986fd29aSsetje
139986fd29aSsetje   \
140986fd29aSsetje   \ indirect block cache
141986fd29aSsetje   \ we assume reads will mostly be sequential, and only
142986fd29aSsetje   \ cache the current indirect block tree
143986fd29aSsetje   \
144986fd29aSsetje   : get-indir  ( fs-blk# var adr -- adr )
145986fd29aSsetje      -rot  dup >r   @ over  =  if             ( adr fs-blk#  r: var )
146986fd29aSsetje         r> 2drop  exit                        ( adr )
147986fd29aSsetje      then                                     ( adr fs-blk#  r: var )
148986fd29aSsetje      2dup  bsize swap  read-fs-blocks         ( adr fs-blk#  r: var )
149986fd29aSsetje      r> !                                     ( adr )
150986fd29aSsetje   ;
151986fd29aSsetje
152986fd29aSsetje   0 instance value indir0-adr
153986fd29aSsetje   instance variable cur-indir0
154986fd29aSsetje   : get-indir0  ( fs-blk# -- adr )
155986fd29aSsetje      cur-indir0 indir0-adr  get-indir
156986fd29aSsetje   ;
157986fd29aSsetje
158986fd29aSsetje   0 instance value indir1-adr
159986fd29aSsetje   instance variable cur-indir1
160986fd29aSsetje   : get-indir1  ( fs-blk# -- adr )
161986fd29aSsetje      cur-indir1 indir1-adr  get-indir
162986fd29aSsetje   ;
163986fd29aSsetje
164986fd29aSsetje   \
165986fd29aSsetje   \ blkptr and blklim point to an array of blk#s,
166986fd29aSsetje   \ whether in the inode direct block array or in
167986fd29aSsetje   \ an indirect block
168986fd29aSsetje   \
169986fd29aSsetje   instance variable blkptr
170986fd29aSsetje   instance variable blklim
171986fd29aSsetje
172986fd29aSsetje   : (bmap)  ( lblk# -- )
173986fd29aSsetje      dup  #direct <  if                           ( lblk# )
174986fd29aSsetje         direct0 swap la+  blkptr  !               (  )
175986fd29aSsetje         direct0 #direct la+  blklim  !
176986fd29aSsetje         exit
177986fd29aSsetje      then                                         ( lblk# )
178986fd29aSsetje
179986fd29aSsetje      #direct -                                    ( lblk#' )
180986fd29aSsetje      dup  #sgl-addr <  if
181986fd29aSsetje         indirect0 l@  get-indir0                  ( lblk# adr )
182986fd29aSsetje         tuck  swap >1-idx la+  blkptr  !          ( adr )
183986fd29aSsetje         #blk-addr/blk la+  blklim  !
184986fd29aSsetje         exit
185986fd29aSsetje      then                                         ( lblk# )
186986fd29aSsetje
187986fd29aSsetje      #sgl-addr -                                  ( lblk#' )
188986fd29aSsetje      dup  #dbl-addr <  if
189986fd29aSsetje         indirect1 l@  get-indir0                  ( lblk# adr )
190986fd29aSsetje         over >2-idx la+ l@  get-indir1            ( lblk# adr' )
191986fd29aSsetje         tuck  swap >1-idx la+  blkptr  !          ( adr )
192986fd29aSsetje         #blk-addr/blk la+  blklim  !              (  )
193986fd29aSsetje         exit
194986fd29aSsetje      then                                         ( lblk# )
195986fd29aSsetje
196986fd29aSsetje\     #dbl-addr -                                  ( lblk#' )
197986fd29aSsetje\     dup  #tri-addr <  if
198986fd29aSsetje\        indirect2 l@  get-indir0                  ( lblk# adr )
199986fd29aSsetje\        over >3-idx la+ l@  get-indir1            ( lblk# adr' )
200986fd29aSsetje\        over >2-idx la+ l@  get-indir2            ( lblk# adr' )
201986fd29aSsetje\        tuck  swap >1-idx la+  blkptr  !          ( adr )
202986fd29aSsetje\        #blk-addr/blk la+  blklim  !              (  )
203986fd29aSsetje\        exit
204986fd29aSsetje\     then                                         ( lblk# )
205986fd29aSsetje      ." file too large" cr  drop true             ( failed )
206986fd29aSsetje   ;
207986fd29aSsetje
208986fd29aSsetje   0 instance value cur-blk
209986fd29aSsetje   : bmap  ( lblk# -- fs-blk# )
210986fd29aSsetje      dup cur-blk <>  blkptr @  blklim @ =  or  if       ( lblk# )
211986fd29aSsetje         dup (bmap)                                      ( lblk# )
212986fd29aSsetje      then                                               ( lblk# )
213986fd29aSsetje      1+ to cur-blk                                      (  )
214986fd29aSsetje      blkptr l@++                                        ( fs-blk# )
215986fd29aSsetje   ;
216986fd29aSsetje
217986fd29aSsetje   : read-one-block ( adr block# -- )
218986fd29aSsetje      bmap  ?dup  if
219986fd29aSsetje         bsize swap  read-fs-blocks
220986fd29aSsetje      else
221986fd29aSsetje         bsize  erase
222986fd29aSsetje      then
223986fd29aSsetje   ;
224986fd29aSsetje
225986fd29aSsetje   : read-partial-block ( adr len off block# -- )
226986fd29aSsetje      bmap  ?dup  if
227986fd29aSsetje         fsbtodb  blk>byte +                        ( adr len byte# )
228986fd29aSsetje         dev-ih  read-disk
229986fd29aSsetje      else
230986fd29aSsetje         drop  erase
231986fd29aSsetje      then
232986fd29aSsetje   ;
233986fd29aSsetje
234986fd29aSsetje   \
235986fd29aSsetje   \	UFS directory routines
236986fd29aSsetje   \
237986fd29aSsetje
238986fd29aSsetje   instance variable dir-blk
239986fd29aSsetje   instance variable totoff
240986fd29aSsetje   instance variable dirptr
241986fd29aSsetje   0 instance value dir-buf
242986fd29aSsetje
243986fd29aSsetje   : get-dirblk  ( -- )
244986fd29aSsetje      dir-buf bsize  dir-blk @  bmap    ( adr len fs-blk# )
245986fd29aSsetje      read-fs-blocks                    ( )
246986fd29aSsetje      1 dir-blk +!
247986fd29aSsetje   ;
248986fd29aSsetje
249986fd29aSsetje   2 constant rootino
250986fd29aSsetje
251986fd29aSsetje   : +d  ( n -- adr ) dirptr @  +  ;
252986fd29aSsetje
253986fd29aSsetje   : dir-ino    ( -- adr ) 0 +d  l@  ;
254986fd29aSsetje   : reclen     ( -- adr ) 4 +d  w@  ;
255986fd29aSsetje   : namelen    ( -- adr ) 6 +d  w@  ;
256986fd29aSsetje   : dir-name   ( -- adr ) 8 +d  ;
257986fd29aSsetje   : dir-name$  ( -- file$ ) dir-name namelen  ;
258986fd29aSsetje
259986fd29aSsetje
260986fd29aSsetje   \
261986fd29aSsetje   \	UFS high-level routines
262986fd29aSsetje   \
263986fd29aSsetje   \       After this point, the code should be independent of the disk format!
264986fd29aSsetje
265986fd29aSsetje   0 instance value search-dir
266986fd29aSsetje   : init-dent
267986fd29aSsetje      0 totoff !  0 dir-blk !
268986fd29aSsetje      current-file to search-dir
269986fd29aSsetje   ;
270986fd29aSsetje
271986fd29aSsetje   : get-dent ( -- end-of-dir? )
272986fd29aSsetje      begin
273986fd29aSsetje         totoff @  file-size >=  if
274986fd29aSsetje            true  exit
275986fd29aSsetje         then
276986fd29aSsetje         totoff @  blkoff  0=  if
277986fd29aSsetje            get-dirblk
278986fd29aSsetje            dir-buf dirptr !
279986fd29aSsetje         else
280986fd29aSsetje            reclen dirptr +!
281986fd29aSsetje         then
282986fd29aSsetje         reclen totoff +!
283986fd29aSsetje         dir-ino  0<>
284986fd29aSsetje      until  false
285986fd29aSsetje   ;
286986fd29aSsetje
287986fd29aSsetje   : dirlook  ( file$ -- not-found? )
288986fd29aSsetje      init-dent
289986fd29aSsetje      begin  get-dent 0=  while      ( file$ )
290986fd29aSsetje         2dup  dir-name$  $=  if     ( file$ )
291986fd29aSsetje            dir-ino iget             ( file$ )
292986fd29aSsetje            2drop  false exit        ( found )
293986fd29aSsetje         then                        ( file$ )
294986fd29aSsetje      repeat  2drop true             ( not-found )
295986fd29aSsetje   ;
296986fd29aSsetje
297986fd29aSsetje   h# 200 constant /fpath-buf
298986fd29aSsetje   /fpath-buf instance buffer: fpath-buf
299986fd29aSsetje   : clr-fpath-buf  ( -- )  fpath-buf /fpath-buf  erase  ;
300986fd29aSsetje   : fpath-buf$  ( -- path$ )  fpath-buf cscount  ;
301986fd29aSsetje
302986fd29aSsetje   : follow-symlink  ( tail$ -- tail$' )
303986fd29aSsetje      clr-fpath-buf                                         ( tail$ )
304986fd29aSsetje      fpath-buf file-size  0 0  read-partial-block          ( tail$ )
305986fd29aSsetje      ?dup  if                                              ( tail$ )
306986fd29aSsetje	 " /" fpath-buf$  $append                           ( tail$ )
307986fd29aSsetje	 fpath-buf$  $append                                (  )
308986fd29aSsetje      else  drop  then                                      (  )
309986fd29aSsetje      fpath-buf$                                            ( path$ )
310986fd29aSsetje      over c@  ascii /  =  if                               ( path$ )
311986fd29aSsetje	 str++  rootino                                     ( path$' i# )
312986fd29aSsetje      else                                                  ( path$ )
313986fd29aSsetje	 search-dir                                         ( path$ i# )
314986fd29aSsetje      then                                                  ( path$ i# )
315986fd29aSsetje      iget                                                  ( path$ )
316986fd29aSsetje   ;
317986fd29aSsetje
318986fd29aSsetje   : lookup  ( path$ -- not-found? )
319986fd29aSsetje      over c@  ascii /  =  if
320986fd29aSsetje         str++  rootino                           ( path$' i# )
321986fd29aSsetje      else
322986fd29aSsetje         current-file                             ( path$ i# )
323986fd29aSsetje      then                                        ( path$ i# )
324986fd29aSsetje      iget                                        ( path$ )
325986fd29aSsetje      begin                                       ( path$ )
326986fd29aSsetje         ascii / left-parse-string                ( path$ file$ )
327986fd29aSsetje      dup  while
328986fd29aSsetje         dir? 0=  if  2drop true  exit  then
329986fd29aSsetje         dirlook  if  2drop true  exit  then      ( path$ )
330986fd29aSsetje         symlink?  if
331986fd29aSsetje            follow-symlink                        ( path$' )
332986fd29aSsetje         then                                     ( path$ )
333986fd29aSsetje      repeat                                      ( path$ file$ )
334986fd29aSsetje      2drop 2drop  false                          ( succeeded )
335986fd29aSsetje   ;
336986fd29aSsetje
337986fd29aSsetje   : i#>name ( i# -- name$ )
338986fd29aSsetje      init-dent                      ( i# )
339986fd29aSsetje      begin  get-dent 0=  while      ( i# )
340986fd29aSsetje         dup dir-ino  =  if          ( i# )
341986fd29aSsetje            drop dir-name$  exit     ( name$ )
342986fd29aSsetje         then                        ( i# )
343986fd29aSsetje      repeat  drop " ???"            ( name$ )
344986fd29aSsetje   ;
345986fd29aSsetje
346986fd29aSsetje
347986fd29aSsetje   \
348986fd29aSsetje   \	UFS installation routines
349986fd29aSsetje   \
350986fd29aSsetje
351986fd29aSsetje   /max-bsize  4 *
352986fd29aSsetje   /super-block    +
353986fd29aSsetje   /inode          +
354986fd29aSsetje   constant alloc-size
355986fd29aSsetje
356986fd29aSsetje   \ **** Allocate memory for necessary data structures
357986fd29aSsetje   : allocate-buffers  ( -- )
358986fd29aSsetje      alloc-size mem-alloc  dup 0=  if
359986fd29aSsetje         ." no memory"  abort
360986fd29aSsetje      then                                ( adr )
361986fd29aSsetje      dup to temp-block   /max-bsize   +  ( adr )
362986fd29aSsetje      dup to dir-buf      /max-bsize   +  ( adr )
363986fd29aSsetje      dup to indir0-adr   /max-bsize   +  ( adr )
364986fd29aSsetje      dup to indir1-adr   /max-bsize   +  ( adr )
365986fd29aSsetje      dup to super-block  /super-block +  ( adr )
366986fd29aSsetje          to inode                        (  )
367986fd29aSsetje   ;
368986fd29aSsetje
369986fd29aSsetje   : release-buffers  ( -- )
370986fd29aSsetje      temp-block  alloc-size  mem-free
371986fd29aSsetje   ;
372986fd29aSsetje
373986fd29aSsetje   \ UFS file interface
374986fd29aSsetje
375986fd29aSsetje   struct
376986fd29aSsetje      /x     field >busy
377986fd29aSsetje      /x     field >offset
378986fd29aSsetje      /inode field >inode
379986fd29aSsetje   constant /file-record
380986fd29aSsetje
381986fd29aSsetje   d# 10                  constant #opens
382986fd29aSsetje   #opens /file-record *  constant /file-records
383986fd29aSsetje
384986fd29aSsetje   /file-records  instance buffer: file-records
385986fd29aSsetje
386986fd29aSsetje   -1 instance value current-fd
387986fd29aSsetje   : fd>record  ( fd -- record )  /file-record *  file-records +  ;
388986fd29aSsetje
389986fd29aSsetje
390986fd29aSsetje   : file-offset@  ( -- off )
391986fd29aSsetje      current-fd fd>record >offset  x@
392986fd29aSsetje   ;
393986fd29aSsetje
394986fd29aSsetje   : file-offset!  ( off -- )
395986fd29aSsetje      current-fd fd>record >offset  x!
396986fd29aSsetje   ;
397986fd29aSsetje
398986fd29aSsetje   : get-slot  ( -- fd false | true )
399986fd29aSsetje      #opens 0  do
400986fd29aSsetje         i fd>record >busy x@  0=  if
401986fd29aSsetje            i false  unloop exit
402986fd29aSsetje         then
403986fd29aSsetje      loop  true
404986fd29aSsetje   ;
405986fd29aSsetje
406986fd29aSsetje   : free-slot  ( fd -- )
407986fd29aSsetje      0 swap  fd>record >busy  x!
408986fd29aSsetje   ;
409986fd29aSsetje
410986fd29aSsetje   : init-fd  ( fd -- )
411986fd29aSsetje      fd>record                ( rec )
412986fd29aSsetje      dup  >busy  1 swap  x!
413986fd29aSsetje      dup  >inode  inode swap  /inode  move
414986fd29aSsetje      >offset  0 swap  x!
415986fd29aSsetje   ;
416986fd29aSsetje
417986fd29aSsetje   : set-fd  ( fd -- error? )
418986fd29aSsetje      dup fd>record  dup >busy x@  0=  if   ( fd rec )
419986fd29aSsetje         2drop true  exit                   ( failed )
420986fd29aSsetje      then
421986fd29aSsetje      >inode to iptr                        ( fd )
422986fd29aSsetje      to current-fd  false                  ( succeeded )
423986fd29aSsetje   ;
424986fd29aSsetje
425986fd29aSsetje
426986fd29aSsetje   \ get current lblk# and offset within it
427986fd29aSsetje   : file-blk+off ( -- off block# )
428986fd29aSsetje      file-offset@ dup  blkoff  swap lblkno
429986fd29aSsetje   ;
430986fd29aSsetje
431986fd29aSsetje   \ advance file io stack by n
432986fd29aSsetje   : fio+  ( # adr len n -- #+n adr+n len-n )
433986fd29aSsetje      dup file-offset@ +  file-offset!
434986fd29aSsetje      dup >r  -  -rot   ( len' # adr  r: n )
435986fd29aSsetje      r@  +  -rot       ( adr' len' #  r: n )
436986fd29aSsetje      r>  +  -rot       ( #' adr' len' )
437986fd29aSsetje   ;
438986fd29aSsetje
439986fd29aSsetje   : (cwd)  ( i# -- )  tokenizer[ reveal ]tokenizer
440986fd29aSsetje      dup rootino  <>  if
441986fd29aSsetje         \ open parent, find current name
442986fd29aSsetje         " .." lookup  drop
443986fd29aSsetje         i#>name                ( name$ )
444986fd29aSsetje         \ recurse to print path components above
445986fd29aSsetje         current-file (cwd)     ( name$ )
446986fd29aSsetje         \ and print this component
447986fd29aSsetje         type                   (  )
448986fd29aSsetje      else  drop  then          (  )
449986fd29aSsetje      \ slash is both root name and separator
450986fd29aSsetje      ." /"
451986fd29aSsetje   ;
452986fd29aSsetje
453986fd29aSsetje   external
454986fd29aSsetje
455986fd29aSsetje   : open ( -- okay? )
456986fd29aSsetje      my-args dev-open  dup 0=  if       ( 0 )
457986fd29aSsetje         exit                            ( failed )
458986fd29aSsetje      then  to dev-ih
459986fd29aSsetje
460986fd29aSsetje      allocate-buffers
461986fd29aSsetje      get-super-block
462986fd29aSsetje      file-records /file-records  erase
463986fd29aSsetje      true                               ( succeeded )
464986fd29aSsetje   ;
465986fd29aSsetje
466986fd29aSsetje   : close  ( -- )
467986fd29aSsetje      dev-ih dev-close
468986fd29aSsetje      0 to dev-ih
469986fd29aSsetje      release-buffers
470986fd29aSsetje   ;
471986fd29aSsetje
472986fd29aSsetje   : open-file  ( path$ -- fd true | false )
473986fd29aSsetje      get-slot  if
474986fd29aSsetje         2drop false  exit         ( failed )
475986fd29aSsetje      then  -rot                   ( fd path$ )
476986fd29aSsetje
477986fd29aSsetje      lookup  if                   ( fd )
478986fd29aSsetje         drop false  exit          ( failed )
479986fd29aSsetje      then
480986fd29aSsetje
481986fd29aSsetje      dup init-fd  true            ( fd succeeded )
482986fd29aSsetje   ;
483986fd29aSsetje
484986fd29aSsetje   : close-file  ( fd -- )
485986fd29aSsetje      free-slot   (  )
486986fd29aSsetje   ;
487986fd29aSsetje
488986fd29aSsetje   : size-file  ( fd -- size )
489986fd29aSsetje      set-fd  if  0  else  file-size  then
490986fd29aSsetje   ;
491986fd29aSsetje
492986fd29aSsetje   : seek-file  ( off fd -- off true | false )
493986fd29aSsetje      set-fd  if                ( off )
494986fd29aSsetje         drop false  exit       ( failed )
495986fd29aSsetje      then                      ( off )
496986fd29aSsetje
497986fd29aSsetje      dup file-size >  if       ( off )
498986fd29aSsetje         drop false  exit       ( failed )
499986fd29aSsetje      then                      ( off )
500986fd29aSsetje      dup  file-offset!  true   ( off succeeded )
501986fd29aSsetje   ;
502986fd29aSsetje
503986fd29aSsetje   : read-file  ( adr len fd -- #read )
504986fd29aSsetje      set-fd  if                   ( adr len )
505986fd29aSsetje         2drop 0  exit             ( 0 )
506986fd29aSsetje      then                         ( adr len )
507986fd29aSsetje
508986fd29aSsetje      regular? 0=  if  2drop 0  exit  then
509986fd29aSsetje
510986fd29aSsetje      \ adjust len if reading past eof
511986fd29aSsetje      dup  file-offset@ +  file-size  >  if
512986fd29aSsetje         dup  file-offset@ +  file-size -  -
513986fd29aSsetje      then
514986fd29aSsetje      dup 0=  if  nip exit  then
515986fd29aSsetje
516986fd29aSsetje      0 -rot                              ( #read adr len )
517986fd29aSsetje
518986fd29aSsetje      \ initial partial block
519986fd29aSsetje      file-offset@ blkoff  ?dup  if       ( #read adr len off )
520986fd29aSsetje         bsize swap -  over  min          ( #read adr len len' )
521986fd29aSsetje         3dup nip  file-blk+off           ( #read adr len len' adr len' off lblk# )
522986fd29aSsetje         read-partial-block               ( #read adr len len )
523986fd29aSsetje         fio+                             ( #read' adr' len' )
524986fd29aSsetje      then                                ( #read adr len )
525986fd29aSsetje
526986fd29aSsetje      dup lblkno  0  ?do                  ( #read adr len )
527986fd29aSsetje         over  file-blk+off nip           ( #read adr len adr lblk# )
528986fd29aSsetje         read-one-block                   ( #read adr len )
529986fd29aSsetje         bsize fio+                       ( #read' adr' len' )
530986fd29aSsetje      loop                                ( #read adr len )
531986fd29aSsetje
532986fd29aSsetje      \ final partial block
533986fd29aSsetje      dup  if                             ( #read adr len )
534986fd29aSsetje         2dup  file-blk+off               ( #read adr len adr len off lblk# )
535986fd29aSsetje         read-partial-block               ( #read adr len )
536986fd29aSsetje         dup fio+                         ( #read' adr' 0 )
537986fd29aSsetje      then  2drop                         ( #read )
538986fd29aSsetje   ;
539986fd29aSsetje
540986fd29aSsetje   : cinfo-file  ( fd -- bsize fsize comp? )
541986fd29aSsetje      set-fd  if  0 0 0  else  bsize file-size comp?  then
542986fd29aSsetje   ;
543986fd29aSsetje
544986fd29aSsetje   \ read ramdisk fcode at rd-offset
545986fd29aSsetje   : get-rd   ( adr len -- )
546986fd29aSsetje      rd-offset dev-ih  read-disk
547986fd29aSsetje   ;
548986fd29aSsetje
549986fd29aSsetje   \ no additional props needed for ufs
550986fd29aSsetje   : bootprop  ( -- )  false  ;
551986fd29aSsetje
552986fd29aSsetje   \ debug words
553986fd29aSsetje   headers
554986fd29aSsetje
555986fd29aSsetje   : chdir  ( dir$ -- )
556986fd29aSsetje      current-file -rot            ( i# dir$ )
557986fd29aSsetje      lookup  if                   ( i# )
558986fd29aSsetje         to current-file           (  )
559986fd29aSsetje         ." no such dir" cr  exit
560986fd29aSsetje      then                         ( i# )
561986fd29aSsetje      dir? 0=  if                  ( i# )
562986fd29aSsetje         to current-file           (  )
563986fd29aSsetje         ." not a dir" cr  exit
564986fd29aSsetje      then  drop                   (  )
565986fd29aSsetje   ;
566986fd29aSsetje
567986fd29aSsetje   : dir  ( -- )
568986fd29aSsetje      current-file iget
569986fd29aSsetje      init-dent
570986fd29aSsetje      begin  get-dent 0=  while
571986fd29aSsetje         dir-name$ type  cr
572986fd29aSsetje      repeat
573986fd29aSsetje   ;
574986fd29aSsetje
575986fd29aSsetje   : cwd  ( -- )
576986fd29aSsetje      current-file        ( i# )
577986fd29aSsetje      dup (cwd)  cr       ( i# )
578986fd29aSsetje      iget                (  )
579986fd29aSsetje   ;
580986fd29aSsetje
581986fd29aSsetjefinish-device
582986fd29aSsetjepop-package
583