1 2\ ident "%Z%%M% %I% %E% SMI" 3\ Copyright 2007 Sun Microsystems, Inc. All rights reserved. 4\ Use is subject to license terms. 5\ 6\ CDDL HEADER START 7\ 8\ The contents of this file are subject to the terms of the 9\ Common Development and Distribution License (the "License"). 10\ You may not use this file except in compliance with the License. 11\ 12\ You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE 13\ or http://www.opensolaris.org/os/licensing. 14\ See the License for the specific language governing permissions 15\ and limitations under the License. 16\ 17\ When distributing Covered Code, include this CDDL HEADER in each 18\ file and include the License file at usr/src/OPENSOLARIS.LICENSE. 19\ If applicable, add the following below this CDDL HEADER, with the 20\ fields enclosed by brackets "[]" replaced with your own identifying 21\ information: Portions Copyright [yyyy] [name of copyright owner] 22\ 23\ CDDL HEADER END 24\ 25\ 26 27[ifdef] doheaders 28headers 29[else] 30headerless 31[then] 32 33 34id: %Z%%M% %I% %E% SMI 35purpose: ZFS file system support package 36copyright: Copyright 2006 Sun Microsystems, Inc. All Rights Reserved 37 38" /packages" get-package push-package 39 40new-device 41 fs-pkg$ device-name diag-cr? 42 43 0 instance value temp-space 44 45 46 \ 64b ops 47 \ fcode is still 32b on 64b sparc-v9, so 48 \ we need to override some arithmetic ops 49 \ stack ops and logical ops (dup, and, etc) are 64b 50 : xcmp ( x1 x2 -- -1|0|1 ) 51 xlsplit rot xlsplit ( x2.lo x2.hi x1.lo x1.hi ) 52 rot 2dup < if ( x2.lo x1.lo x1.hi x2.hi ) 53 2drop 2drop -1 ( lt ) 54 else > if ( x2.lo x1.lo ) 55 2drop 1 ( gt ) 56 else swap 2dup < if ( x1.lo x2.lo ) 57 2drop -1 ( lt ) 58 else > if ( ) 59 1 ( gt ) 60 else ( ) 61 0 ( eq ) 62 then then then then ( -1|0|1 ) 63 ; 64 : x< ( x1 x2 -- <? ) xcmp -1 = ; 65 : x> ( x1 x2 -- >? ) xcmp 1 = ; 66\ : x= ( x1 x2 -- =? ) xcmp 0= ; 67 : x<> ( x1 x2 -- <>? ) xcmp 0<> ; 68 : x0= ( x -- 0=? ) xlsplit 0= swap 0= and ; 69 70 /buf-len instance buffer: numbuf 71 72 : (xu.) ( u -- u$ ) 73 numbuf /buf-len + swap ( adr u ) 74 begin 75 d# 10 /mod swap ( adr u' rem ) 76 ascii 0 + ( adr u' c ) 77 rot 1- tuck c! ( u adr' ) 78 swap dup 0= ( adr u done? ) 79 until drop ( adr ) 80 dup numbuf - /buf-len swap - ( adr len ) 81 ; 82 83 \ pool name 84 /buf-len instance buffer: bootprop-buf 85 : bootprop$ ( -- prop$ ) bootprop-buf cscount ; 86 87 \ decompression 88 \ 89 \ uts/common/os/compress.c has a definitive theory of operation comment 90 \ on lzjb, but here's the reader's digest version: 91 \ 92 \ repeated phrases are replaced by referenced to the original 93 \ e.g., 94 \ y a d d a _ y a d d a _ y a d d a , _ b l a h _ b l a h _ b l a h 95 \ becomes 96 \ y a d d a _ 6 11 , _ b l a h 5 10 97 \ where 6 11 means memmove(ptr, ptr - 6, 11) 98 \ 99 \ data is separated from metadata with embedded copymap entries 100 \ every 8 items e.g., 101 \ 0x40 y a d d a _ 6 11 , 0x20 _ b l a h 5 10 102 \ the copymap has a set bit for copy refercences 103 \ and a clear bit for bytes to be copied directly 104 \ 105 \ the reference marks are encoded with match-bits and match-min 106 \ e.g., 107 \ byte[0] = ((mlen - MATCH_MIN) << (NBBY - MATCH_BITS) | (off >> NBBY) 108 \ byte[1] = (uint8_t)off 109 \ 110 111 : pow2 ( n -- 2**n ) 1 swap lshift ; 112 113 \ assume MATCH_BITS=6 and MATCH_MIN=3 114 6 constant mbits 115 3 constant mmin 116 8 mbits - constant mshift 117 d# 16 mbits - pow2 1- constant mmask 118 119 : decode-src ( src -- mlen off ) 120 dup c@ swap 1+ c@ ( c[0] c[1] ) 121 over mshift rshift mmin + ( c[0] c[1] mlen ) 122 -rot swap bwjoin mmask and ( mlen off ) 123 ; 124 125 \ equivalent of memmove(dst, dst - off, len) 126 \ src points to a copy reference to be decoded 127 : mcopy ( dend dst src -- dend dst' ) 128 decode-src ( dend dst mlen off ) 129 2 pick swap - >r ( dent dst mlen r: cpy ) 130 begin 131 1- dup 0>= ( dend dst mlen' any? r: cpy ) 132 2over > and ( dend dst mlen !done? r : cpy ) 133 while ( dend dst mlen r: cpy ) 134 swap r> dup 1+ >r c@ ( dend mlen dst c r: cpy' ) 135 over c! 1+ swap ( dend dst' mlen r: cpy ) 136 repeat ( dend dst' mlen r: cpy ) 137 r> 2drop ( dend dst ) 138 ; 139 140 141 : lzjb ( src dst len -- ) 142 over + swap ( src dend dst ) 143 rot >r ( dend dst r: src ) 144 145 \ setup mask so 1st while iteration fills map 146 0 7 pow2 2swap ( map mask dend dst r: src ) 147 148 begin 2dup > while 149 2swap 1 lshift ( dend dst map mask' r: src ) 150 151 dup 8 pow2 = if 152 \ fetch next copymap 153 2drop ( dend dst r: src ) 154 r> dup 1+ >r c@ 1 ( dend dst map' mask' r: src' ) 155 then ( dend dst map mask r: src' ) 156 157 \ if (map & mask) we hit a copy reference 158 \ else just copy 1 byte 159 2swap 2over and if ( map mask dend dst r: src ) 160 r> dup 2+ >r ( map mask dend dst src r: src' ) 161 mcopy ( map mask dend dst' r: src ) 162 else 163 r> dup 1+ >r c@ ( map mask dend dst c r: src' ) 164 over c! 1+ ( map mask dend dst' r: src ) 165 then 166 repeat ( map mask dend dst r: src ) 167 2drop 2drop r> drop ( ) 168 ; 169 170 171 \ 172 \ ZFS block (SPA) routines 173 \ 174 175 2 constant no-comp# 176 h# 2.0000 constant /max-bsize 177 d# 512 constant /disk-block 178 d# 128 constant /blkp 179 180 : blk_offset ( bp -- n ) h# 8 + x@ -1 h# 8fff.ffff lxjoin and ; 181 : blk_gang ( bp -- n ) h# 8 + x@ xlsplit nip d# 31 rshift ; 182 : blk_comp ( bp -- n ) h# 33 + c@ ; 183 : blk_psize ( bp -- n ) h# 34 + w@ ; 184 : blk_lsize ( bp -- n ) h# 36 + w@ ; 185 : blk_birth ( bp -- n ) h# 50 + x@ ; 186 187 0 instance value dev-ih 188 0 instance value blk-space 189 0 instance value gang-space 190 191 : foff>doff ( fs-off -- disk-off ) /disk-block * h# 40.0000 + ; 192 : fsz>dsz ( fs-size -- disk-size ) 1+ /disk-block * ; 193 194 : bp-dsize ( bp -- dsize ) blk_psize fsz>dsz ; 195 : bp-lsize ( bp -- lsize ) blk_lsize fsz>dsz ; 196 197 : (read-bp) ( adr len bp -- ) 198 blk_offset foff>doff dev-ih read-disk 199 ; 200 201 : gang-read ( adr len bp -- ) 202 203 \ read gang block 204 gang-space /disk-block rot ( adr len gb-adr gb-len bp ) 205 (read-bp) ( adr len ) 206 207 \ read gang indirected blocks to blk-space 208 \ and copy requested len from there 209 blk-space gang-space ( adr len tmp-adr bp0 ) 210 dup /blkp 3 * + bounds do ( adr len tmp-adr ) 211 i blk_offset x0= ?leave 212 i bp-dsize ( adr len tmp-adr rd-len ) 213 2dup i (read-bp) 214 + ( adr len tmp-adr' ) 215 /blkp +loop 216 drop ( adr len ) 217 blk-space -rot move ( ) 218 ; 219 220 \ block read that check for holes, gangs, compression, etc 221 : read-bp ( adr len bp -- ) 222 \ sparse block? 223 dup blk_birth x0= if 224 drop erase exit ( ) 225 then 226 \ gang block? 227 dup blk_gang if 228 gang-read exit ( ) 229 then 230 \ compression? 231 dup blk_comp no-comp# <> if 232 blk-space over bp-dsize ( adr len bp b-adr rd-len ) 233 rot (read-bp) ( adr len ) 234 blk-space -rot lzjb exit ( ) 235 then 236 \ boring direct block 237 (read-bp) ( ) 238 ; 239 240 \ 241 \ ZFS vdev routines 242 \ 243 244 h# 1.c000 constant /nvpairs 245 h# 4000 constant nvpairs-off 246 247 \ 248 \ xdr packed nvlist 249 \ 250 \ 12B header 251 \ array of xdr packed nvpairs 252 \ 4B encoded nvpair size 253 \ 4B decoded nvpair size 254 \ 4B name string size 255 \ name string 256 \ 4B data type 257 \ 4B # of data elements 258 \ data 259 \ 8B of 0 260 \ 261 d# 12 constant /nvhead 262 263 : >nvsize ( nv -- size ) l@ ; 264 : >nvname ( nv -- name$ ) 265 /l 2* + dup /l + swap l@ 266 ; 267 : >nvdata ( nv -- data ) 268 >nvname + /l roundup 269 ; 270 alias nvdata>$ >nvname 271 272 : nv-lookup ( nv name$ -- nvdata false | true ) 273 rot /nvhead + ( name$ nvpair ) 274 begin dup >nvsize while 275 dup >r >nvname ( name$ nvname$ r: nvpair ) 276 2over $= if ( name$ r: nvpair ) 277 2drop r> >nvdata ( nvdata ) 278 false exit ( nvdata found ) 279 then ( name$ r: nvpair ) 280 r> dup >nvsize + ( name$ nvpair' ) 281 repeat 282 3drop true ( not-found ) 283 ; 284 285 : scan-vdev ( -- ) 286 temp-space /nvpairs nvpairs-off ( adr len off ) 287 dev-ih read-disk ( ) 288 temp-space " name" nv-lookup if 289 ." no name nvpair" abort 290 then nvdata>$ ( pool$ ) 291 bootprop-buf swap move ( ) 292 ; 293 294 295 \ 296 \ ZFS ueber-block routines 297 \ 298 299 d# 1024 constant /uber-block 300 d# 128 constant #ub/label 301 #ub/label /uber-block * constant /ub-ring 302 h# 2.0000 constant ubring-off 303 304 : ub_magic ( ub -- n ) x@ ; 305 : ub_txg ( ub -- n ) h# 10 + x@ ; 306 : ub_timestamp ( ub -- n ) h# 20 + x@ ; 307 : ub_rootbp ( ub -- p ) h# 28 + ; 308 309 0 instance value uber-block 310 311 : ub-cmp ( ub1 ub2 -- best-ub ) 312 313 \ ub1 wins if ub2 isn't valid 314 dup ub_magic h# 00bab10c x<> if 315 drop exit ( ub1 ) 316 then 317 318 \ if ub1 is 0, ub2 wins by default 319 over 0= if nip exit then ( ub2 ) 320 321 \ 2 valid ubs, compare transaction groups 322 over ub_txg over ub_txg ( ub1 ub2 txg1 txg2 ) 323 2dup x< if 324 2drop nip exit ( ub2 ) 325 then ( ub1 ub2 txg1 txg2 ) 326 x> if drop exit then ( ub1 ) 327 328 \ same txg, check timestamps 329 over ub_timestamp over ub_timestamp x> if 330 nip ( ub2 ) 331 else 332 drop ( ub1 ) 333 then 334 ; 335 336 \ find best uber-block in ring, and copy it to uber-block 337 : get-ub ( -- ) 338 temp-space /ub-ring ubring-off ( adr len off ) 339 dev-ih read-disk ( ) 340 0 temp-space /ub-ring ( null-ub adr len ) 341 bounds do ( ub ) 342 i ub-cmp ( best-ub ) 343 /uber-block +loop 344 345 \ make sure we found a valid ub 346 dup 0= if ." no ub found" abort then 347 348 uber-block /uber-block move ( ) 349 ; 350 351 352 \ 353 \ ZFS dnode (DMU) routines 354 \ 355 356 d# 512 constant /dnode 357 358 : dn_indblkshift ( dn -- n ) h# 1 + c@ ; 359 : dn_nlevels ( dn -- n ) h# 2 + c@ ; 360 : dn_datablkszsec ( dn -- n ) h# 8 + w@ ; 361 : dn_blkptr ( dn -- p ) h# 40 + ; 362 : dn_bonus ( dn -- p ) h# c0 + ; 363 364 0 instance value dnode 365 366 \ indirect cache 367 \ 368 \ ind-cache is a 1 block indirect block cache from dnode ic-dn 369 \ 370 \ ic-bp and ic-bplim point into the ic-dn's block ptr array, 371 \ either in dn_blkptr or in ind-cache ic-bp is the ic-blk#'th 372 \ block ptr, and ic-bplim is limit of the current bp array 373 \ 374 \ the assumption is that reads will be sequential, so we can 375 \ just increment ic-bp 376 \ 377 0 instance value ind-cache 378 0 instance value ic-dn 379 0 instance value ic-blk# 380 0 instance value ic-bp 381 0 instance value ic-bplim 382 383 : dn-bsize ( dn -- bsize ) dn_datablkszsec /disk-block * ; 384 : dn-indsize ( dn -- indsize ) dn_indblkshift pow2 ; 385 : dn-indmask ( dn -- mask ) dn-indsize 1- ; 386 387 \ recursively climb the block tree from the leaf to the root 388 : blk@lvl>bp ( dn blk# lvl -- bp ) tokenizer[ reveal ]tokenizer 389 >r /blkp * over dn_nlevels ( dn bp-off #lvls r: lvl ) 390 391 \ at top, just add dn_blkptr 392 r@ = if ( dn bp-off r: lvl ) 393 swap dn_blkptr + ( bp r: lvl ) 394 r> drop exit ( bp ) 395 then ( dn bp-off r: lvl ) 396 397 \ shift bp-off down and find parent indir blk 398 2dup over dn_indblkshift rshift ( dn bp-off dn blk# r: lvl ) 399 r> 1+ blk@lvl>bp ( dn bp-off bp ) 400 401 \ read parent indir and index 402 rot tuck dn-indsize ( bp-off dn bp len ) 403 ind-cache swap rot read-bp ( bp-off dn ) 404 dn-indmask and ( bp-off' ) 405 ind-cache + ( bp ) 406 ; 407 408 \ return end of current bp array 409 : bplim ( dn bp -- bp-lim ) 410 over dn_nlevels 1 = if 411 drop dn_blkptr ( bp0 ) 412 3 /blkp * + ( bplim ) 413 else 414 1+ swap dn-indsize ( bp+1 indsz ) 415 roundup ( bplim ) 416 then 417 ; 418 419 \ return the lblk#'th block ptr from dnode 420 : lblk#>bp ( dn blk# -- bp ) 421 2dup ( dn blk# dn blk# ) 422 ic-blk# <> swap ic-dn <> or ( dn blk# cache-miss? ) 423 ic-bp ic-bplim = ( dn blk# cache-miss? cache-empty? ) 424 or if ( dn blk# ) 425 2dup 1 blk@lvl>bp ( dn blk# bp ) 426 dup to ic-bp ( dn blk# bp ) 427 swap to ic-blk# ( dn bp ) 428 2dup bplim to ic-bplim ( dn bp ) 429 over to ic-dn 430 then 2drop ( ) 431 ic-blk# 1+ to ic-blk# 432 ic-bp dup /blkp + to ic-bp ( bp ) 433 ; 434 435 436 \ 437 \ ZFS attribute (ZAP) routines 438 \ 439 440 1 constant fzap# 441 3 constant uzap# 442 443 d# 64 constant /uzap 444 445 d# 24 constant /lf-chunk 446 d# 21 constant /lf-arr 447 h# ffff constant chain-end# 448 449 h# 100 constant /lf-buf 450 /lf-buf instance buffer: leaf-value 451 /lf-buf instance buffer: leaf-name 452 453 : +le ( len off -- n ) + w@ ; 454 : le_next ( le -- n ) h# 2 +le ; 455 : le_name_chunk ( le -- n ) h# 4 +le ; 456 : le_name_length ( le -- n ) h# 6 +le ; 457 : le_value_chunk ( le -- n ) h# 8 +le ; 458 : le_value_length ( le -- n ) h# a +le ; 459 460 : la_array ( la -- adr ) 1+ ; 461 : la_next ( la -- n ) h# 16 + w@ ; 462 463 0 instance value zap-space 464 465 \ setup leaf hash bounds 466 : >leaf-hash ( dn lh -- hash-adr /hash ) 467 /lf-chunk 2* + ( dn hash-adr ) 468 \ size = (bsize / 32) * 2 469 swap dn-bsize 4 rshift ( hash-adr /hash ) 470 ; 471 : >leaf-chunks ( lf -- ch0 ) >leaf-hash + ; 472 473 \ convert chunk # to leaf chunk 474 : ch#>lc ( dn ch# -- lc ) 475 /lf-chunk * ( dn lc-off ) 476 swap zap-space >leaf-chunks ( lc-off ch0 ) 477 + ( lc ) 478 ; 479 480 \ assemble chunk chain into single buffer 481 : get-chunk-data ( dn ch# adr -- ) 482 dup >r /lf-buf erase ( dn ch# r: adr ) 483 begin 484 2dup ch#>lc nip ( dn la r: adr ) 485 dup la_array ( dn la la-arr r: adr ) 486 r@ /lf-arr move ( dn la r: adr ) 487 r> /lf-arr + >r ( dn la r: adr' ) 488 la_next dup chain-end# = ( dn la-ch# end? r: adr ) 489 until r> 3drop ( ) 490 ; 491 492 \ get leaf entry's name 493 : entry-name$ ( dn le -- name$ ) 494 2dup le_name_chunk ( dn le dn la-ch# ) 495 leaf-name get-chunk-data ( dn le ) 496 nip le_name_length ( len ) 497 leaf-name swap ( name$ ) 498 ; 499 500 \ return entry value as int 501 : entry-int-val ( dn le -- n ) 502 le_value_chunk ( dn la-ch# ) 503 leaf-value get-chunk-data ( ) 504 leaf-value x@ ( n ) 505 ; 506 507 508[ifdef] strlookup 509 \ get leaf entry's value as string 510 : entry-val$ ( dn le -- val$ ) 511 2dup le_value_chunk ( dn le dn la-ch# ) 512 leaf-value get-chunk-data ( dn le ) 513 nip le_value_length ( len ) 514 leaf-value swap ( name$ ) 515 ; 516[then] 517 518 \ apply xt to entry 519 : entry-apply ( xt dn le -- xt dn false | ??? true ) 520 over >r ( xt dn le r: dn ) 521 rot dup >r execute if ( ??? r: xt dn ) 522 r> r> 2drop true ( ??? true ) 523 else ( ) 524 r> r> false ( xt dn false ) 525 then 526 ; 527 528 \ apply xt to every entry in chain 529 : chain-apply ( xt dn ch# -- xt dn false | ??? true ) 530 begin 531 2dup ch#>lc nip ( xt dn le ) 532 dup >r entry-apply if ( ??? r: le ) 533 r> drop true exit ( ??? found ) 534 then ( xt dn r: le ) 535 r> le_next ( xt dn ch# ) 536 dup chain-end# = ( xt dn ch# end? ) 537 until drop ( xt dn ) 538 false ( xt dn false ) 539 ; 540 541 \ apply xt to every entry in leaf 542 : leaf-apply ( xt dn blk# -- xt dn false | ??? true ) 543 544 \ read zap leaf into zap-space 545 2dup lblk#>bp ( xt dn blk# bp ) 546 nip over dn-bsize zap-space ( xt dn bp len adr ) 547 swap rot read-bp ( xt dn ) 548 549 \ call chunk-look for every valid chunk list 550 dup zap-space >leaf-hash ( xt dn hash-adr /hash ) 551 bounds do ( xt dn ) 552 i w@ dup chain-end# <> if ( xt dn ch# ) 553 chain-apply if ( ??? ) 554 unloop true exit ( ??? found ) 555 then ( xt dn ) 556 else drop then ( xt dn ) 557 /w +loop 558 false ( xt dn not-found ) 559 ; 560 561 \ apply xt to every entry in fzap 562 : fzap-apply ( xt dn fz -- ??? not-found? ) 563 564 \ blk# 1 is always the 1st leaf 565 >r 1 leaf-apply if ( ??? r: fz ) 566 r> drop false exit ( ??? found ) 567 then r> ( xt dn fz ) 568 569 \ call leaf-apply on every non-duplicate hash entry 570 \ embedded hash is in 2nd half of fzap block 571 over dn-bsize tuck + ( xt dn bsize hash-eadr ) 572 swap 2dup 2/ - ( xt dn hash-eadr bsize hash-adr ) 573 nip do ( xt dn ) 574 i x@ dup 1 <> if ( xt dn blk# ) 575 leaf-apply if ( ??? ) 576 unloop true exit ( ??? found ) 577 then ( xt dn ) 578 else drop then ( xt dn ) 579 /x +loop 580 2drop false ( not-found ) 581 ; 582 583 : mze_value ( uz -- n ) x@ ; 584 : mze_name ( uz -- p ) h# e + ; 585 586 : uzap-name$ ( uz -- name$ ) mze_name cscount ; 587 588 \ apply xt to each entry in micro-zap 589 : uzap-apply ( xt uz len -- ??? not-found? ) 590 bounds do ( xt ) 591 i swap dup >r ( uz xt r: xt ) 592 execute if ( ??? r: xt ) 593 r> drop ( ??? ) 594 unloop true exit ( ??? found ) 595 then r> ( xt ) 596 /uzap +loop 597 drop false ( not-found ) 598 ; 599 600 \ match by name 601 : fz-nmlook ( prop$ dn le -- prop$ false | prop$ dn le true ) 602 2dup entry-name$ ( prop$ dn le name$ ) 603 2rot 2swap ( dn le prop$ name$ ) 604 2over $= if ( dn le prop$ ) 605 2swap true ( prop$ dn le true ) 606 else ( dn le prop$ ) 607 2swap 2drop false ( prop$ false ) 608 then ( prop$ false | prop$ dn le true ) 609 ; 610 611 \ match by name 612 : uz-nmlook ( prop$ uz -- prop$ false | prop$ uz true ) 613 dup >r uzap-name$ ( prop$ name$ r: uz ) 614 2over $= if ( prop$ r: uz ) 615 r> true ( prop$ uz true ) 616 else ( prop$ r: uz ) 617 r> drop false ( prop$ false ) 618 then ( prop$ false | prop$ uz true ) 619 ; 620 621 : zap-type ( zp -- n ) h# 7 + c@ ; 622 : >uzap-ent ( adr -- ent ) h# 40 + ; 623 624 \ read zap block into temp-space 625 : get-zap ( dn -- zp ) 626 dup 0 lblk#>bp ( dn bp ) 627 swap dn-bsize ( bp len ) 628 temp-space swap ( bp adr len ) 629 rot read-bp ( ) 630 temp-space ( zp ) 631 ; 632 633 \ find prop in zap dnode 634 : zap-lookup ( dn prop$ -- [ n ] not-found? ) 635 rot dup get-zap ( prop$ dn zp ) 636 dup zap-type case 637 uzap# of 638 >uzap-ent swap dn-bsize ( prop$ uz len ) 639 ['] uz-nmlook -rot ( prop$ xt uz len ) 640 uzap-apply if ( prop$ uz ) 641 mze_value -rot 2drop ( n ) 642 false ( n found ) 643 else ( prop$ ) 644 2drop true ( !found ) 645 then ( [ n ] not-found? ) 646 endof 647 fzap# of 648 ['] fz-nmlook -rot ( prop$ xt dn fz ) 649 fzap-apply if ( prop$ dn le ) 650 entry-int-val ( prop$ n ) 651 -rot 2drop false ( n found ) 652 else ( prop$ ) 653 2drop true ( !found ) 654 then ( [ n ] not-found? ) 655 endof 656 3drop 2drop true ( !found ) 657 endcase ( [ n ] not-found? ) 658 ; 659 660[ifdef] strlookup 661 : zap-lookup-str ( dn prop$ -- [ val$ ] not-found? ) 662 rot dup get-zap ( prop$ dn zp ) 663 dup zap-type fzap# <> if ( prop$ dn zp ) 664 2drop 2drop true exit ( !found ) 665 then ( prop$ dn zp ) 666 ['] fz-nmlook -rot ( prop$ xt dn fz ) 667 fzap-apply if ( prop$ dn le ) 668 entry-val$ 2swap 2drop false ( val$ found ) 669 else ( prop$ ) 670 2drop true ( !found ) 671 then ( [ val$ ] not-found? ) 672 ; 673[then] 674 675[ifdef] bigbootblk 676 : fz-print ( dn le -- false ) 677 entry-name$ type cr false 678 ; 679 680 : uz-print ( uz -- false ) 681 uzap-name$ type cr false 682 ; 683 684 : zap-print ( dn -- ) 685 dup get-zap ( dn zp ) 686 dup zap-type case 687 uzap# of 688 >uzap-ent swap dn-bsize ( uz len ) 689 ['] uz-print -rot ( xt uz len ) 690 uzap-apply ( false ) 691 endof 692 fzap# of 693 ['] fz-print -rot ( xt dn fz ) 694 fzap-apply ( false ) 695 endof 696 3drop false ( false ) 697 endcase ( false ) 698 drop ( ) 699 ; 700[then] 701 702 703 \ 704 \ ZFS object set (DSL) routines 705 \ 706 707 1 constant pool-dir# 708 709 : dd_head_dataset_obj ( dd -- n ) h# 8 + x@ ; 710 : dd_child_dir_zapobj ( dd -- n ) h# 20 + x@ ; 711 : ds_bp ( ds -- p ) h# 80 + ; 712 713 0 instance value mos-dn 714 0 instance value obj-dir 715 0 instance value root-dsl 716 0 instance value root-dsl# 717 0 instance value fs-dn 718 719 \ dn-cache contains dc-dn's contents at dc-blk# 720 \ dc-dn will be either mos-dn or fs-dn 721 0 instance value dn-cache 722 0 instance value dc-dn 723 0 instance value dc-blk# 724 725 alias >dsl-dir dn_bonus 726 alias >dsl-ds dn_bonus 727 728 : #dn/blk ( dn -- n ) dn-bsize /dnode / ; 729 730 \ read block into dn-cache 731 : get-dnblk ( dn blk# -- ) 732 lblk#>bp dn-cache swap ( adr bp ) 733 dup bp-lsize swap read-bp ( ) 734 ; 735 736 \ read obj# from objset dir dn into dnode 737 : get-dnode ( dn obj# -- ) 738 739 \ check dn-cache 740 2dup swap #dn/blk /mod ( dn obj# off# blk# ) 741 swap >r nip ( dn blk# r: off# ) 742 2dup dc-blk# <> ( dn blk# dn !blk-hit? r: off# ) 743 swap dc-dn <> or if ( dn blk# r: off# ) 744 \ cache miss, fill from dir 745 2dup get-dnblk 746 over to dc-dn 747 dup to dc-blk# 748 then ( dn blk# r: off# ) 749 750 \ index and copy 751 2drop r> /dnode * ( off ) 752 dn-cache + ( dn-adr ) 753 dnode /dnode move ( ) 754 ; 755 756 \ read meta object set from uber-block 757 : get-mos ( -- ) 758 mos-dn /dnode ( adr len ) 759 uber-block ub_rootbp read-bp 760 ; 761 762 : get-mos-dnode ( obj# -- ) 763 mos-dn swap get-dnode 764 ; 765 766 \ get root dataset 767 : get-root-dsl ( -- ) 768 769 \ read MOS 770 get-mos 771 772 \ read object dir 773 pool-dir# get-mos-dnode 774 dnode obj-dir /dnode move 775 776 \ read root dataset 777 obj-dir " root_dataset" zap-lookup if 778 ." no root_dataset" abort 779 then ( obj# ) 780 dup to root-dsl# 781 get-mos-dnode ( ) 782 dnode root-dsl /dnode move 783 ; 784 785 \ look thru the dsl hierarchy for path 786 \ this looks almost exactly like a FS directory lookup 787 : dsl-lookup ( path$ -- [ ds-obj# ] not-found? ) 788 root-dsl >r ( path$ r: root-dn ) 789 begin 790 ascii / left-parse-string ( path$ file$ r: dn ) 791 dup while 792 793 \ get child dir zap dnode 794 r> >dsl-dir dd_child_dir_zapobj ( path$ file$ obj# ) 795 get-mos-dnode ( path$ file$ ) 796 797 \ search it 798 dnode -rot zap-lookup if ( path$ ) 799 \ not found 800 2drop true exit ( not-found ) 801 then ( path$ obj# ) 802 get-mos-dnode ( path$ ) 803 dnode >r ( path$ r: dn ) 804 repeat ( path$ file$ r: dn) 805 2drop 2drop r> drop ( ) 806 807 \ found it, return dataset obj# 808 dnode >dsl-dir dd_head_dataset_obj ( ds-obj# ) 809 false ( ds-obj# found ) 810 ; 811 812 \ get objset from dataset 813 : get-objset ( adr dn -- ) 814 >dsl-ds ds_bp /dnode swap read-bp 815 ; 816 817 818 \ 819 \ ZFS file-system (ZPL) routines 820 \ 821 822 1 constant master-node# 823 d# 264 constant /znode 824 d# 56 constant /zn-slink 825 826 : zp_mode ( zn -- n ) h# 48 + x@ ; 827 : zp_size ( zn -- n ) h# 50 + x@ ; 828 : zp_parent ( zn -- n ) h# 58 + x@ ; 829 830 0 instance value bootfs-obj# 831 0 instance value root-obj# 832 0 instance value current-obj# 833 0 instance value search-obj# 834 835 alias >znode dn_bonus 836 837 : fsize ( dn -- n ) >znode zp_size ; 838 : ftype ( dn -- n ) >znode zp_mode h# f000 and ; 839 : dir? ( dn -- flag ) ftype h# 4000 = ; 840 : regular? ( dn -- flag ) ftype h# 8000 = ; 841 : symlink? ( dn -- flag ) ftype h# a000 = ; 842 843 \ read obj# from fs objset 844 : get-fs-dnode ( obj# -- ) 845 dup to current-obj# 846 fs-dn swap get-dnode ( ) 847 ; 848 849 \ get root-obj# from dataset 850 : get-rootobj# ( ds-obj# -- fsroot-obj# ) 851 dup to bootfs-obj# 852 get-mos-dnode ( ) 853 fs-dn dnode get-objset 854 855 \ get root obj# from master node 856 master-node# get-fs-dnode 857 dnode " ROOT" zap-lookup if 858 ." no ROOT" abort 859 then ( fsroot-obj# ) 860 ; 861 862 : prop>rootobj# ( -- ) 863 obj-dir " pool_props" zap-lookup if 864 ." no pool_props" abort 865 then ( prop-obj# ) 866 get-mos-dnode ( ) 867 dnode " bootfs" zap-lookup if 868 ." no bootfs" abort 869 then ( ds-obj# ) 870 get-rootobj# ( fsroot-obj# ) 871 ; 872 873 : fs>rootobj# ( fs$ -- root-obj# not-found? ) 874 875 \ skip pool name 876 ascii / left-parse-string 2drop 877 878 \ lookup fs in dsl 879 dsl-lookup if ( ) 880 true exit ( not-found ) 881 then ( ds-obj# ) 882 883 get-rootobj# ( fsroot-obj# ) 884 false ( fsroot-obj# found ) 885 ; 886 887 \ lookup file is current directory 888 : dirlook ( file$ dn -- not-found? ) 889 \ . and .. are magic 890 -rot 2dup " ." $= if ( dn file$ ) 891 3drop false exit ( found ) 892 then 893 894 2dup " .." $= if 895 2drop >znode zp_parent ( obj# ) 896 else ( dn file$ ) 897 \ search dir 898 current-obj# to search-obj# 899 zap-lookup if ( ) 900 true exit ( not-found ) 901 then ( obj# ) 902 then ( obj# ) 903 get-fs-dnode false ( found ) 904 ; 905 906 /buf-len instance buffer: fpath-buf 907 : clr-fpath-buf ( -- ) fpath-buf /buf-len erase ; 908 909 : fpath-buf$ ( -- path$ ) fpath-buf cscount ; 910 911 \ copy symlink target to adr 912 : readlink ( dst dn -- ) 913 dup fsize tuck /zn-slink > if ( dst size dn ) 914 \ contents in 1st block 915 temp-space over dn-bsize ( dst size dn t-adr bsize ) 916 rot 0 lblk#>bp read-bp ( dst size ) 917 temp-space ( dst size src ) 918 else ( dst size dn ) 919 \ contents in dnode 920 >znode /znode + ( dst size src ) 921 then ( dst size src ) 922 -rot move ( ) 923 ; 924 925 \ modify tail to account for symlink 926 : follow-symlink ( tail$ -- tail$' ) 927 clr-fpath-buf ( tail$ ) 928 fpath-buf dnode readlink 929 930 \ append to current path 931 ?dup if ( tail$ ) 932 " /" fpath-buf$ $append ( tail$ ) 933 fpath-buf$ $append ( ) 934 else drop then ( ) 935 fpath-buf$ ( path$ ) 936 937 \ get directory that starts changed path 938 over c@ ascii / = if ( path$ ) 939 str++ root-obj# ( path$' obj# ) 940 else ( path$ ) 941 search-obj# ( path$ obj# ) 942 then ( path$ obj# ) 943 get-fs-dnode ( path$ ) 944 ; 945 946 \ open dnode at path 947 : lookup ( path$ -- not-found? ) 948 949 \ get directory that starts path 950 over c@ ascii / = if 951 str++ root-obj# ( path$' obj# ) 952 else 953 current-obj# ( path$ obj# ) 954 then ( path$ obj# ) 955 get-fs-dnode ( path$ ) 956 957 \ lookup each path component 958 begin ( path$ ) 959 ascii / left-parse-string ( path$ file$ ) 960 dup while 961 dnode dir? 0= if 962 2drop true exit ( not-found ) 963 then ( path$ file$ ) 964 dnode dirlook if ( path$ ) 965 2drop true exit ( not-found ) 966 then ( path$ ) 967 dnode symlink? if 968 follow-symlink ( path$' ) 969 then ( path$ ) 970 repeat ( path$ file$ ) 971 2drop 2drop false ( found ) 972 ; 973 974 \ 975 \ ZFS installation routines 976 \ 977 978 \ ZFS file interface 979 struct 980 /x field >busy 981 /x field >offset 982 /dnode field >dnode 983 constant /file-record 984 985 d# 10 constant #opens 986 #opens /file-record * constant /file-records 987 988 /file-records instance buffer: file-records 989 990 -1 instance value current-fd 991 992 : fd>record ( fd -- rec ) /file-record * file-records + ; 993 : file-offset@ ( -- off ) current-fd fd>record >offset x@ ; 994 : file-offset! ( off -- ) current-fd fd>record >offset x! ; 995 : file-dnode ( -- dn ) current-fd fd>record >dnode ; 996 : file-size ( -- size ) file-dnode fsize ; 997 : file-bsize ( -- bsize ) file-dnode dn-bsize ; 998 999 \ find free fd slot 1000 : get-slot ( -- fd false | true ) 1001 #opens 0 do 1002 i fd>record >busy x@ 0= if 1003 i false unloop exit 1004 then 1005 loop true 1006 ; 1007 1008 : free-slot ( fd -- ) 1009 0 swap fd>record >busy x! 1010 ; 1011 1012 \ init fd to offset 0 and copy dnode 1013 : init-fd ( fd -- ) 1014 fd>record ( rec ) 1015 dup >busy 1 swap x! 1016 dup >dnode dnode swap /dnode move 1017 >offset 0 swap x! 1018 ; 1019 1020 \ make fd current 1021 : set-fd ( fd -- error? ) 1022 dup fd>record >busy x@ 0= if ( fd ) 1023 drop true exit ( failed ) 1024 then ( fd ) 1025 to current-fd false ( succeeded ) 1026 ; 1027 1028 \ read next fs block 1029 : file-bread ( adr -- ) 1030 file-bsize ( adr len ) 1031 file-offset@ over / ( adr len blk# ) 1032 file-dnode swap lblk#>bp ( adr len bp ) 1033 read-bp ( ) 1034 ; 1035 1036 \ advance file io stack by n 1037 : fio+ ( # adr len n -- #+n adr+n len-n ) 1038 dup file-offset@ + file-offset! 1039 dup >r - -rot ( len' # adr r: n ) 1040 r@ + -rot ( adr' len' # r: n ) 1041 r> + -rot ( #' adr' len' ) 1042 ; 1043 1044 /max-bsize 5 * 1045 /uber-block + 1046 /dnode 5 * + 1047 /disk-block + 1048 constant alloc-size 1049 1050 : allocate-buffers ( -- ) 1051 alloc-size h# a0.0000 vmem-alloc dup 0= if 1052 ." no memory" abort 1053 then ( adr ) 1054 dup to temp-space /max-bsize + ( adr ) 1055 dup to dn-cache /max-bsize + ( adr ) 1056 dup to blk-space /max-bsize + ( adr ) 1057 dup to ind-cache /max-bsize + ( adr ) 1058 dup to zap-space /max-bsize + ( adr ) 1059 dup to uber-block /uber-block + ( adr ) 1060 dup to mos-dn /dnode + ( adr ) 1061 dup to obj-dir /dnode + ( adr ) 1062 dup to root-dsl /dnode + ( adr ) 1063 dup to fs-dn /dnode + ( adr ) 1064 dup to dnode /dnode + ( adr ) 1065 to gang-space ( ) 1066 1067 \ zero instance buffers 1068 file-records /file-records erase 1069 bootprop-buf /buf-len erase 1070 ; 1071 1072 : release-buffers ( -- ) 1073 temp-space alloc-size mem-free 1074 ; 1075 1076 external 1077 1078 : open ( -- okay? ) 1079 my-args dev-open dup 0= if 1080 exit ( failed ) 1081 then to dev-ih 1082 1083 allocate-buffers 1084 scan-vdev 1085 get-ub 1086 get-root-dsl 1087 true 1088 ; 1089 1090 : open-fs ( fs$ -- okay? ) 1091 fs>rootobj# if ( ) 1092 false ( failed ) 1093 else ( obj# ) 1094 to root-obj# true ( succeeded ) 1095 then ( okay? ) 1096 ; 1097 1098 : close ( -- ) 1099 dev-ih dev-close 1100 0 to dev-ih 1101 release-buffers 1102 ; 1103 1104 : open-file ( path$ -- fd true | false ) 1105 1106 \ open default fs if no open-fs 1107 root-obj# 0= if 1108 prop>rootobj# to root-obj# 1109 then 1110 1111 get-slot if 1112 2drop false exit ( failed ) 1113 then -rot ( fd path$ ) 1114 1115 lookup if ( fd ) 1116 drop false exit ( failed ) 1117 then ( fd ) 1118 1119 dup init-fd true ( fd succeeded ) 1120 ; 1121 1122 : close-file ( fd -- ) 1123 free-slot ( ) 1124 ; 1125 1126 : size-file ( fd -- size ) 1127 set-fd if 0 else file-size then 1128 ; 1129 1130 : seek-file ( off fd -- off true | false ) 1131 set-fd if ( off ) 1132 drop false exit ( failed ) 1133 then ( off ) 1134 1135 dup file-size > if ( off ) 1136 drop false exit ( failed ) 1137 then ( off ) 1138 dup file-offset! true ( off succeeded ) 1139 ; 1140 1141 : read-file ( adr len fd -- #read ) 1142 set-fd if ( adr len ) 1143 2drop 0 exit ( 0 ) 1144 then ( adr len ) 1145 1146 file-dnode regular? 0= if 2drop 0 exit then 1147 1148 \ adjust len if reading past eof 1149 dup file-offset@ + file-size > if 1150 dup file-offset@ + file-size - - 1151 then 1152 dup 0= if nip exit then 1153 1154 0 -rot ( #read adr len ) 1155 1156 \ initial partial block 1157 file-offset@ file-bsize mod ?dup if ( #read adr len off ) 1158 temp-space file-bread 1159 2dup file-bsize swap - min ( #read adr len off cpy-len ) 1160 2over drop -rot ( #read adr len adr off cpy-len ) 1161 >r temp-space + swap ( #read adr len cpy-src adr r: cpy-len ) 1162 r@ move r> fio+ ( #read' adr' len' ) 1163 then ( #read adr len ) 1164 1165 dup file-bsize / 0 ?do ( #read adr len ) 1166 over file-bread 1167 file-bsize fio+ ( #read' adr' len' ) 1168 loop ( #read adr len ) 1169 1170 \ final partial block 1171 dup if ( #read adr len ) 1172 temp-space file-bread 1173 2dup temp-space -rot move ( #read adr len ) 1174 dup fio+ ( #read' adr' 0 ) 1175 then 2drop ( #read ) 1176 ; 1177 1178 : cinfo-file ( fd -- bsize fsize comp? ) 1179 set-fd if 1180 0 0 0 1181 else 1182 file-bsize file-size ( bsize fsize ) 1183 \ zfs does internal compression 1184 0 ( bsize fsize comp? ) 1185 then 1186 ; 1187 1188 \ read ramdisk fcode at rd-offset 1189 : get-rd ( adr len -- ) 1190 rd-offset dev-ih read-disk 1191 ; 1192 1193 : bootprop 1194 " /" bootprop$ $append 1195 bootfs-obj# (xu.) bootprop$ $append 1196 bootprop$ encode-string " zfs-bootfs" ( propval propname ) 1197 true 1198 ; 1199 1200 1201[ifdef] bigbootblk 1202 : chdir ( dir$ -- ) 1203 current-obj# -rot ( obj# dir$ ) 1204 lookup if ( obj# ) 1205 to current-obj# ( ) 1206 ." no such dir" cr exit 1207 then ( obj# ) 1208 dnode dir? 0= if ( obj# ) 1209 to current-obj# ( ) 1210 ." not a dir" cr exit 1211 then drop ( ) 1212 ; 1213 1214 : dir ( -- ) 1215 current-obj# get-fs-dnode 1216 dnode zap-print 1217 ; 1218[then] 1219 1220finish-device 1221pop-package 1222