1 2\ ident "%Z%%M% %I% %E% SMI" 3\ Copyright 2008 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 u< if ( x2.lo x1.lo x1.hi x2.hi ) 53 2drop 2drop -1 ( lt ) 54 else u> if ( x2.lo x1.lo ) 55 2drop 1 ( gt ) 56 else swap 2dup u< if ( x1.lo x2.lo ) 57 2drop -1 ( lt ) 58 else u> 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 271 \ convert nvdata to 64b int or string 272 : nvdata>x ( nvdata -- x ) 273 /l 2* + ( ptr ) 274 dup /l + l@ swap l@ ( x.lo x.hi ) 275 lxjoin ( x ) 276 ; 277 alias nvdata>$ >nvname 278 279 : nv-lookup ( nv name$ -- nvdata false | true ) 280 rot /nvhead + ( name$ nvpair ) 281 begin dup >nvsize while 282 dup >r >nvname ( name$ nvname$ r: nvpair ) 283 2over $= if ( name$ r: nvpair ) 284 2drop r> >nvdata ( nvdata ) 285 false exit ( nvdata found ) 286 then ( name$ r: nvpair ) 287 r> dup >nvsize + ( name$ nvpair' ) 288 repeat 289 3drop true ( not-found ) 290 ; 291 292 : scan-vdev ( -- ) 293 temp-space /nvpairs nvpairs-off ( adr len off ) 294 dev-ih read-disk ( ) 295 temp-space " txg" nv-lookup if 296 " no txg nvpair" die 297 then nvdata>x ( txg ) 298 x0= if 299 " detached mirror" die 300 then ( ) 301 temp-space " name" nv-lookup if 302 " no name nvpair" die 303 then nvdata>$ ( pool$ ) 304 bootprop-buf swap move ( ) 305 ; 306 307 308 \ 309 \ ZFS ueber-block routines 310 \ 311 312 d# 1024 constant /uber-block 313 d# 128 constant #ub/label 314 #ub/label /uber-block * constant /ub-ring 315 h# 2.0000 constant ubring-off 316 317 : ub_magic ( ub -- n ) x@ ; 318 : ub_txg ( ub -- n ) h# 10 + x@ ; 319 : ub_timestamp ( ub -- n ) h# 20 + x@ ; 320 : ub_rootbp ( ub -- p ) h# 28 + ; 321 322 0 instance value uber-block 323 324 : ub-cmp ( ub1 ub2 -- best-ub ) 325 326 \ ub1 wins if ub2 isn't valid 327 dup ub_magic h# 00bab10c x<> if 328 drop exit ( ub1 ) 329 then 330 331 \ if ub1 is 0, ub2 wins by default 332 over 0= if nip exit then ( ub2 ) 333 334 \ 2 valid ubs, compare transaction groups 335 over ub_txg over ub_txg ( ub1 ub2 txg1 txg2 ) 336 2dup x< if 337 2drop nip exit ( ub2 ) 338 then ( ub1 ub2 txg1 txg2 ) 339 x> if drop exit then ( ub1 ) 340 341 \ same txg, check timestamps 342 over ub_timestamp over ub_timestamp x> if 343 nip ( ub2 ) 344 else 345 drop ( ub1 ) 346 then 347 ; 348 349 \ find best uber-block in ring, and copy it to uber-block 350 : get-ub ( -- ) 351 temp-space /ub-ring ubring-off ( adr len off ) 352 dev-ih read-disk ( ) 353 0 temp-space /ub-ring ( null-ub adr len ) 354 bounds do ( ub ) 355 i ub-cmp ( best-ub ) 356 /uber-block +loop 357 358 \ make sure we found a valid ub 359 dup 0= if " no ub found" die then 360 361 uber-block /uber-block move ( ) 362 ; 363 364 365 \ 366 \ ZFS dnode (DMU) routines 367 \ 368 369 d# 512 constant /dnode 370 371 : dn_indblkshift ( dn -- n ) h# 1 + c@ ; 372 : dn_nlevels ( dn -- n ) h# 2 + c@ ; 373 : dn_datablkszsec ( dn -- n ) h# 8 + w@ ; 374 : dn_blkptr ( dn -- p ) h# 40 + ; 375 : dn_bonus ( dn -- p ) h# c0 + ; 376 377 0 instance value dnode 378 379 \ indirect cache 380 \ 381 \ ind-cache is a 1 block indirect block cache from dnode ic-dn 382 \ 383 \ ic-bp and ic-bplim point into the ic-dn's block ptr array, 384 \ either in dn_blkptr or in ind-cache ic-bp is the ic-blk#'th 385 \ block ptr, and ic-bplim is limit of the current bp array 386 \ 387 \ the assumption is that reads will be sequential, so we can 388 \ just increment ic-bp 389 \ 390 0 instance value ind-cache 391 0 instance value ic-dn 392 0 instance value ic-blk# 393 0 instance value ic-bp 394 0 instance value ic-bplim 395 396 : dn-bsize ( dn -- bsize ) dn_datablkszsec /disk-block * ; 397 : dn-indsize ( dn -- indsize ) dn_indblkshift pow2 ; 398 : dn-indmask ( dn -- mask ) dn-indsize 1- ; 399 400 \ recursively climb the block tree from the leaf to the root 401 : blk@lvl>bp ( dn blk# lvl -- bp ) tokenizer[ reveal ]tokenizer 402 >r /blkp * over dn_nlevels ( dn bp-off #lvls r: lvl ) 403 404 \ at top, just add dn_blkptr 405 r@ = if ( dn bp-off r: lvl ) 406 swap dn_blkptr + ( bp r: lvl ) 407 r> drop exit ( bp ) 408 then ( dn bp-off r: lvl ) 409 410 \ shift bp-off down and find parent indir blk 411 2dup over dn_indblkshift rshift ( dn bp-off dn blk# r: lvl ) 412 r> 1+ blk@lvl>bp ( dn bp-off bp ) 413 414 \ read parent indir blk and index 415 rot tuck dn-indsize ( bp-off dn bp len ) 416 ind-cache swap rot read-bp ( bp-off dn ) 417 dn-indmask and ( bp-off' ) 418 ind-cache + ( bp ) 419 ; 420 421 \ return end of current bp array 422 : bplim ( dn bp -- bp-lim ) 423 over dn_nlevels 1 = if 424 drop dn_blkptr ( bp0 ) 425 3 /blkp * + ( bplim ) 426 else 427 1+ swap dn-indsize ( bp+1 indsz ) 428 roundup ( bplim ) 429 then 430 ; 431 432 \ return the lblk#'th block ptr from dnode 433 : lblk#>bp ( dn blk# -- bp ) 434 2dup ( dn blk# dn blk# ) 435 ic-blk# <> swap ic-dn <> or ( dn blk# cache-miss? ) 436 ic-bp ic-bplim = ( dn blk# cache-miss? cache-empty? ) 437 or if ( dn blk# ) 438 2dup 1 blk@lvl>bp ( dn blk# bp ) 439 dup to ic-bp ( dn blk# bp ) 440 swap to ic-blk# ( dn bp ) 441 2dup bplim to ic-bplim ( dn bp ) 442 over to ic-dn 443 then 2drop ( ) 444 ic-blk# 1+ to ic-blk# 445 ic-bp dup /blkp + to ic-bp ( bp ) 446 ; 447 448 449 \ 450 \ ZFS attribute (ZAP) routines 451 \ 452 453 1 constant fzap# 454 3 constant uzap# 455 456 d# 64 constant /uzap 457 458 d# 24 constant /lf-chunk 459 d# 21 constant /lf-arr 460 h# ffff constant chain-end# 461 462 h# 100 constant /lf-buf 463 /lf-buf instance buffer: leaf-value 464 /lf-buf instance buffer: leaf-name 465 466 : +le ( len off -- n ) + w@ ; 467 : le_next ( le -- n ) h# 2 +le ; 468 : le_name_chunk ( le -- n ) h# 4 +le ; 469 : le_name_length ( le -- n ) h# 6 +le ; 470 : le_value_chunk ( le -- n ) h# 8 +le ; 471 : le_value_length ( le -- n ) h# a +le ; 472 473 : la_array ( la -- adr ) 1+ ; 474 : la_next ( la -- n ) h# 16 + w@ ; 475 476 0 instance value zap-space 477 478 \ setup leaf hash bounds 479 : >leaf-hash ( dn lh -- hash-adr /hash ) 480 /lf-chunk 2* + ( dn hash-adr ) 481 \ size = (bsize / 32) * 2 482 swap dn-bsize 4 rshift ( hash-adr /hash ) 483 ; 484 : >leaf-chunks ( lf -- ch0 ) >leaf-hash + ; 485 486 \ convert chunk # to leaf chunk 487 : ch#>lc ( dn ch# -- lc ) 488 /lf-chunk * ( dn lc-off ) 489 swap zap-space >leaf-chunks ( lc-off ch0 ) 490 + ( lc ) 491 ; 492 493 \ assemble chunk chain into single buffer 494 : get-chunk-data ( dn ch# adr -- ) 495 dup >r /lf-buf erase ( dn ch# r: adr ) 496 begin 497 2dup ch#>lc nip ( dn la r: adr ) 498 dup la_array ( dn la la-arr r: adr ) 499 r@ /lf-arr move ( dn la r: adr ) 500 r> /lf-arr + >r ( dn la r: adr' ) 501 la_next dup chain-end# = ( dn la-ch# end? r: adr ) 502 until r> 3drop ( ) 503 ; 504 505 \ get leaf entry's name 506 : entry-name$ ( dn le -- name$ ) 507 2dup le_name_chunk ( dn le dn la-ch# ) 508 leaf-name get-chunk-data ( dn le ) 509 nip le_name_length 1- ( len ) 510 leaf-name swap ( name$ ) 511 ; 512 513 \ return entry value as int 514 : entry-int-val ( dn le -- n ) 515 le_value_chunk ( dn la-ch# ) 516 leaf-value get-chunk-data ( ) 517 leaf-value x@ ( n ) 518 ; 519 520 521[ifdef] strlookup 522 \ get leaf entry's value as string 523 : entry-val$ ( dn le -- val$ ) 524 2dup le_value_chunk ( dn le dn la-ch# ) 525 leaf-value get-chunk-data ( dn le ) 526 nip le_value_length ( len ) 527 leaf-value swap ( name$ ) 528 ; 529[then] 530 531 \ apply xt to entry 532 : entry-apply ( xt dn le -- xt dn false | ??? true ) 533 over >r ( xt dn le r: dn ) 534 rot dup >r execute if ( ??? r: xt dn ) 535 r> r> 2drop true ( ??? true ) 536 else ( ) 537 r> r> false ( xt dn false ) 538 then 539 ; 540 541 \ apply xt to every entry in chain 542 : chain-apply ( xt dn ch# -- xt dn false | ??? true ) 543 begin 544 2dup ch#>lc nip ( xt dn le ) 545 dup >r entry-apply if ( ??? r: le ) 546 r> drop true exit ( ??? found ) 547 then ( xt dn r: le ) 548 r> le_next ( xt dn ch# ) 549 dup chain-end# = ( xt dn ch# end? ) 550 until drop ( xt dn ) 551 false ( xt dn false ) 552 ; 553 554 \ apply xt to every entry in leaf 555 : leaf-apply ( xt dn blk# -- xt dn false | ??? true ) 556 557 \ read zap leaf into zap-space 558 2dup lblk#>bp ( xt dn blk# bp ) 559 nip over dn-bsize zap-space ( xt dn bp len adr ) 560 swap rot read-bp ( xt dn ) 561 562 \ call chunk-look for every valid chunk list 563 dup zap-space >leaf-hash ( xt dn hash-adr /hash ) 564 bounds do ( xt dn ) 565 i w@ dup chain-end# <> if ( xt dn ch# ) 566 chain-apply if ( ??? ) 567 unloop true exit ( ??? found ) 568 then ( xt dn ) 569 else drop then ( xt dn ) 570 /w +loop 571 false ( xt dn not-found ) 572 ; 573 574 \ apply xt to every entry in fzap 575 : fzap-apply ( xt dn fz -- ??? not-found? ) 576 577 \ blk# 1 is always the 1st leaf 578 >r 1 leaf-apply if ( ??? r: fz ) 579 r> drop true exit ( ??? found ) 580 then r> ( xt dn fz ) 581 582 \ call leaf-apply on every non-duplicate hash entry 583 \ embedded hash is in 2nd half of fzap block 584 over dn-bsize tuck + ( xt dn bsize hash-eadr ) 585 swap 2dup 2/ - ( xt dn hash-eadr bsize hash-adr ) 586 nip do ( xt dn ) 587 i x@ dup 1 <> if ( xt dn blk# ) 588 leaf-apply if ( ??? ) 589 unloop true exit ( ??? found ) 590 then ( xt dn ) 591 else drop then ( xt dn ) 592 /x +loop 593 2drop false ( not-found ) 594 ; 595 596 : mze_value ( uz -- n ) x@ ; 597 : mze_name ( uz -- p ) h# e + ; 598 599 : uzap-name$ ( uz -- name$ ) mze_name cscount ; 600 601 \ apply xt to each entry in micro-zap 602 : uzap-apply ( xt uz len -- ??? not-found? ) 603 bounds do ( xt ) 604 i swap dup >r ( uz xt r: xt ) 605 execute if ( ??? r: xt ) 606 r> drop ( ??? ) 607 unloop true exit ( ??? found ) 608 then r> ( xt ) 609 /uzap +loop 610 drop false ( not-found ) 611 ; 612 613 \ match by name 614 : fz-nmlook ( prop$ dn le -- prop$ false | prop$ dn le true ) 615 2dup entry-name$ ( prop$ dn le name$ ) 616 2rot 2swap ( dn le prop$ name$ ) 617 2over $= if ( dn le prop$ ) 618 2swap true ( prop$ dn le true ) 619 else ( dn le prop$ ) 620 2swap 2drop false ( prop$ false ) 621 then ( prop$ false | prop$ dn le true ) 622 ; 623 624 \ match by name 625 : uz-nmlook ( prop$ uz -- prop$ false | prop$ uz true ) 626 dup >r uzap-name$ ( prop$ name$ r: uz ) 627 2over $= if ( prop$ r: uz ) 628 r> true ( prop$ uz true ) 629 else ( prop$ r: uz ) 630 r> drop false ( prop$ false ) 631 then ( prop$ false | prop$ uz true ) 632 ; 633 634 : zap-type ( zp -- n ) h# 7 + c@ ; 635 : >uzap-ent ( adr -- ent ) h# 40 + ; 636 637 \ read zap block into temp-space 638 : get-zap ( dn -- zp ) 639 dup 0 lblk#>bp ( dn bp ) 640 swap dn-bsize ( bp len ) 641 temp-space swap ( bp adr len ) 642 rot read-bp ( ) 643 temp-space ( zp ) 644 ; 645 646 \ find prop in zap dnode 647 : zap-lookup ( dn prop$ -- [ n ] not-found? ) 648 rot dup get-zap ( prop$ dn zp ) 649 dup zap-type case 650 uzap# of 651 >uzap-ent swap dn-bsize ( prop$ uz len ) 652 ['] uz-nmlook -rot ( prop$ xt uz len ) 653 uzap-apply if ( prop$ uz ) 654 mze_value -rot 2drop ( n ) 655 false ( n found ) 656 else ( prop$ ) 657 2drop true ( !found ) 658 then ( [ n ] not-found? ) 659 endof 660 fzap# of 661 ['] fz-nmlook -rot ( prop$ xt dn fz ) 662 fzap-apply if ( prop$ dn le ) 663 entry-int-val ( prop$ n ) 664 -rot 2drop false ( n found ) 665 else ( prop$ ) 666 2drop true ( !found ) 667 then ( [ n ] not-found? ) 668 endof 669 3drop 2drop true ( !found ) 670 endcase ( [ n ] not-found? ) 671 ; 672 673[ifdef] strlookup 674 : zap-lookup-str ( dn prop$ -- [ val$ ] not-found? ) 675 rot dup get-zap ( prop$ dn zp ) 676 dup zap-type fzap# <> if ( prop$ dn zp ) 677 2drop 2drop true exit ( !found ) 678 then ( prop$ dn zp ) 679 ['] fz-nmlook -rot ( prop$ xt dn fz ) 680 fzap-apply if ( prop$ dn le ) 681 entry-val$ 2swap 2drop false ( val$ found ) 682 else ( prop$ ) 683 2drop true ( !found ) 684 then ( [ val$ ] not-found? ) 685 ; 686[then] 687 688[ifdef] bigbootblk 689 : fz-print ( dn le -- false ) 690 entry-name$ type cr false 691 ; 692 693 : uz-print ( uz -- false ) 694 uzap-name$ type cr false 695 ; 696 697 : zap-print ( dn -- ) 698 dup get-zap ( dn zp ) 699 dup zap-type case 700 uzap# of 701 >uzap-ent swap dn-bsize ( uz len ) 702 ['] uz-print -rot ( xt uz len ) 703 uzap-apply ( false ) 704 endof 705 fzap# of 706 ['] fz-print -rot ( xt dn fz ) 707 fzap-apply ( false ) 708 endof 709 3drop false ( false ) 710 endcase ( false ) 711 drop ( ) 712 ; 713[then] 714 715 716 \ 717 \ ZFS object set (DSL) routines 718 \ 719 720 1 constant pool-dir# 721 722 : dd_head_dataset_obj ( dd -- n ) h# 8 + x@ ; 723 : dd_child_dir_zapobj ( dd -- n ) h# 20 + x@ ; 724 725 : ds_snapnames_zapobj ( ds -- n ) h# 20 + x@ ; 726 : ds_bp ( ds -- p ) h# 80 + ; 727 728 0 instance value mos-dn 729 0 instance value obj-dir 730 0 instance value root-dsl 731 0 instance value root-dsl# 732 0 instance value fs-dn 733 734 \ dn-cache contains dc-dn's contents at dc-blk# 735 \ dc-dn will be either mos-dn or fs-dn 736 0 instance value dn-cache 737 0 instance value dc-dn 738 0 instance value dc-blk# 739 740 alias >dsl-dir dn_bonus 741 alias >dsl-ds dn_bonus 742 743 : #dn/blk ( dn -- n ) dn-bsize /dnode / ; 744 745 \ read block into dn-cache 746 : get-dnblk ( dn blk# -- ) 747 lblk#>bp dn-cache swap ( adr bp ) 748 dup bp-lsize swap read-bp ( ) 749 ; 750 751 \ read obj# from objset dir dn into dnode 752 : get-dnode ( dn obj# -- ) 753 754 \ check dn-cache 755 2dup swap #dn/blk /mod ( dn obj# off# blk# ) 756 swap >r nip ( dn blk# r: off# ) 757 2dup dc-blk# <> ( dn blk# dn !blk-hit? r: off# ) 758 swap dc-dn <> or if ( dn blk# r: off# ) 759 \ cache miss, fill from dir 760 2dup get-dnblk 761 over to dc-dn 762 dup to dc-blk# 763 then ( dn blk# r: off# ) 764 765 \ index and copy 766 2drop r> /dnode * ( off ) 767 dn-cache + ( dn-adr ) 768 dnode /dnode move ( ) 769 ; 770 771 \ read meta object set from uber-block 772 : get-mos ( -- ) 773 mos-dn /dnode ( adr len ) 774 uber-block ub_rootbp read-bp 775 ; 776 777 : get-mos-dnode ( obj# -- ) 778 mos-dn swap get-dnode 779 ; 780 781 \ get root dataset 782 : get-root-dsl ( -- ) 783 784 \ read MOS 785 get-mos 786 787 \ read object dir 788 pool-dir# get-mos-dnode 789 dnode obj-dir /dnode move 790 791 \ read root dataset 792 obj-dir " root_dataset" zap-lookup if 793 " no root_dataset" die 794 then ( obj# ) 795 dup to root-dsl# 796 get-mos-dnode ( ) 797 dnode root-dsl /dnode move 798 ; 799 800 \ find snapshot of given dataset 801 : snap-look ( snap$ ds-obj# -- [ss-obj# ] not-found? ) 802 get-mos-dnode dnode >dsl-ds ( snap$ ds ) 803 ds_snapnames_zapobj get-mos-dnode ( snap$ ) 804 dnode -rot zap-lookup ( [ss-obj# ] not-found? ) 805 ; 806 807 \ dsl dir to dataset 808 : dir>ds ( dn -- obj# ) >dsl-dir dd_head_dataset_obj ; 809 810 \ look thru the dsl hierarchy for path 811 \ this looks almost exactly like a FS directory lookup 812 : dsl-lookup ( path$ -- [ ds-obj# ] not-found? ) 813 root-dsl >r ( path$ r: root-dn ) 814 begin 815 ascii / left-parse-string ( path$ file$ r: dn ) 816 dup while 817 818 \ get child dir zap dnode 819 r> >dsl-dir dd_child_dir_zapobj ( path$ file$ obj# ) 820 get-mos-dnode ( path$ file$ ) 821 822 \ check for snapshot names 823 ascii @ left-parse-string ( path$ snap$ file$ ) 824 825 \ search it 826 dnode -rot zap-lookup if ( path$ snap$ ) 827 \ not found 828 2drop 2drop true exit ( not-found ) 829 then ( path$ snap$ obj# ) 830 get-mos-dnode ( path$ snap$ ) 831 832 \ lookup any snapshot name 833 dup if 834 \ must be last path component 835 2swap nip if ( snap$ ) 836 2drop true exit ( not-found ) 837 then 838 dnode dir>ds snap-look if ( ) 839 true exit ( not-found ) 840 then ( obj# ) 841 false exit ( obj# found ) 842 else 2drop then ( path$ ) 843 844 dnode >r ( path$ r: dn ) 845 repeat ( path$ file$ r: dn) 846 2drop 2drop r> drop ( ) 847 848 \ found it, return dataset obj# 849 dnode dir>ds ( ds-obj# ) 850 false ( ds-obj# found ) 851 ; 852 853 \ get objset from dataset 854 : get-objset ( adr dn -- ) 855 >dsl-ds ds_bp /dnode swap read-bp 856 ; 857 858 859 \ 860 \ ZFS file-system (ZPL) routines 861 \ 862 863 1 constant master-node# 864 d# 264 constant /znode 865 d# 56 constant /zn-slink 866 867 : zp_mode ( zn -- n ) h# 48 + x@ ; 868 : zp_size ( zn -- n ) h# 50 + x@ ; 869 : zp_parent ( zn -- n ) h# 58 + x@ ; 870 871 0 instance value bootfs-obj# 872 0 instance value root-obj# 873 0 instance value current-obj# 874 0 instance value search-obj# 875 876 alias >znode dn_bonus 877 878 : fsize ( dn -- n ) >znode zp_size ; 879 : ftype ( dn -- n ) >znode zp_mode h# f000 and ; 880 : dir? ( dn -- flag ) ftype h# 4000 = ; 881 : symlink? ( dn -- flag ) ftype h# a000 = ; 882 883 \ read obj# from fs objset 884 : get-fs-dnode ( obj# -- ) 885 dup to current-obj# 886 fs-dn swap get-dnode ( ) 887 ; 888 889 \ get root-obj# from dataset 890 : get-rootobj# ( ds-obj# -- fsroot-obj# ) 891 dup to bootfs-obj# 892 get-mos-dnode ( ) 893 fs-dn dnode get-objset 894 895 \ get root obj# from master node 896 master-node# get-fs-dnode 897 dnode " ROOT" zap-lookup if 898 " no ROOT" die 899 then ( fsroot-obj# ) 900 ; 901 902 : prop>rootobj# ( -- ) 903 obj-dir " pool_props" zap-lookup if 904 " no pool_props" die 905 then ( prop-obj# ) 906 get-mos-dnode ( ) 907 dnode " bootfs" zap-lookup if 908 " no bootfs" die 909 then ( ds-obj# ) 910 get-rootobj# ( fsroot-obj# ) 911 ; 912 913 : fs>rootobj# ( fs$ -- root-obj# not-found? ) 914 915 \ skip pool name 916 ascii / left-parse-string 2drop 917 918 \ lookup fs in dsl 919 dsl-lookup if ( ) 920 true exit ( not-found ) 921 then ( ds-obj# ) 922 923 get-rootobj# ( fsroot-obj# ) 924 false ( fsroot-obj# found ) 925 ; 926 927 \ lookup file is current directory 928 : dirlook ( file$ dn -- not-found? ) 929 \ . and .. are magic 930 -rot 2dup " ." $= if ( dn file$ ) 931 3drop false exit ( found ) 932 then 933 934 2dup " .." $= if 935 2drop >znode zp_parent ( obj# ) 936 else ( dn file$ ) 937 \ search dir 938 current-obj# to search-obj# 939 zap-lookup if ( ) 940 true exit ( not-found ) 941 then ( obj# ) 942 then ( obj# ) 943 get-fs-dnode false ( found ) 944 ; 945 946 /buf-len instance buffer: fpath-buf 947 : clr-fpath-buf ( -- ) fpath-buf /buf-len erase ; 948 949 : fpath-buf$ ( -- path$ ) fpath-buf cscount ; 950 951 \ copy symlink target to adr 952 : readlink ( dst dn -- ) 953 dup fsize tuck /zn-slink > if ( dst size dn ) 954 \ contents in 1st block 955 temp-space over dn-bsize ( dst size dn t-adr bsize ) 956 rot 0 lblk#>bp read-bp ( dst size ) 957 temp-space ( dst size src ) 958 else ( dst size dn ) 959 \ contents in dnode 960 >znode /znode + ( dst size src ) 961 then ( dst size src ) 962 -rot move ( ) 963 ; 964 965 \ modify tail to account for symlink 966 : follow-symlink ( tail$ -- tail$' ) 967 clr-fpath-buf ( tail$ ) 968 fpath-buf dnode readlink 969 970 \ append to current path 971 ?dup if ( tail$ ) 972 " /" fpath-buf$ $append ( tail$ ) 973 fpath-buf$ $append ( ) 974 else drop then ( ) 975 fpath-buf$ ( path$ ) 976 977 \ get directory that starts changed path 978 over c@ ascii / = if ( path$ ) 979 str++ root-obj# ( path$' obj# ) 980 else ( path$ ) 981 search-obj# ( path$ obj# ) 982 then ( path$ obj# ) 983 get-fs-dnode ( path$ ) 984 ; 985 986 \ open dnode at path 987 : lookup ( path$ -- not-found? ) 988 989 \ get directory that starts path 990 over c@ ascii / = if 991 str++ root-obj# ( path$' obj# ) 992 else 993 current-obj# ( path$ obj# ) 994 then ( path$ obj# ) 995 get-fs-dnode ( path$ ) 996 997 \ lookup each path component 998 begin ( path$ ) 999 ascii / left-parse-string ( path$ file$ ) 1000 dup while 1001 dnode dir? 0= if 1002 2drop true exit ( not-found ) 1003 then ( path$ file$ ) 1004 dnode dirlook if ( path$ ) 1005 2drop true exit ( not-found ) 1006 then ( path$ ) 1007 dnode symlink? if 1008 follow-symlink ( path$' ) 1009 then ( path$ ) 1010 repeat ( path$ file$ ) 1011 2drop 2drop false ( found ) 1012 ; 1013 1014 \ 1015 \ ZFS volume (ZVOL) routines 1016 \ 1017 1 constant zvol-data# 1018 2 constant zvol-prop# 1019 1020 0 instance value zv-dn 1021 1022 : get-zvol ( zvol$ -- not-found? ) 1023 dsl-lookup if 1024 drop true exit ( failed ) 1025 then ( ds-obj# ) 1026 1027 \ get zvol objset 1028 get-mos-dnode ( ) 1029 zv-dn dnode get-objset 1030 false ( succeeded ) 1031 ; 1032 1033 \ get zvol data dnode 1034 : zvol-data ( -- ) 1035 zv-dn zvol-data# get-dnode 1036 ; 1037 1038 : zvol-size ( -- size ) 1039 zv-dn zvol-prop# get-dnode 1040 dnode " size" zap-lookup if 1041 " no zvol size" die 1042 then ( size ) 1043 ; 1044 1045 1046 \ 1047 \ ZFS installation routines 1048 \ 1049 1050 \ ZFS file interface 1051 struct 1052 /x field >busy 1053 /x field >offset 1054 /x field >fsize 1055 /dnode field >dnode 1056 constant /file-record 1057 1058 d# 10 constant #opens 1059 #opens /file-record * constant /file-records 1060 1061 /file-records instance buffer: file-records 1062 1063 -1 instance value current-fd 1064 1065 : fd>record ( fd -- rec ) /file-record * file-records + ; 1066 : file-offset@ ( -- off ) current-fd fd>record >offset x@ ; 1067 : file-offset! ( off -- ) current-fd fd>record >offset x! ; 1068 : file-dnode ( -- dn ) current-fd fd>record >dnode ; 1069 : file-size ( -- size ) current-fd fd>record >fsize x@ ; 1070 : file-bsize ( -- bsize ) file-dnode dn-bsize ; 1071 1072 \ find free fd slot 1073 : get-slot ( -- fd false | true ) 1074 #opens 0 do 1075 i fd>record >busy x@ 0= if 1076 i false unloop exit 1077 then 1078 loop true 1079 ; 1080 1081 : free-slot ( fd -- ) 1082 0 swap fd>record >busy x! 1083 ; 1084 1085 \ init fd to offset 0 and copy dnode 1086 : init-fd ( fsize fd -- ) 1087 fd>record ( fsize rec ) 1088 dup >busy 1 swap x! 1089 dup >dnode dnode swap /dnode move 1090 dup >fsize rot swap x! ( rec ) 1091 >offset 0 swap x! ( ) 1092 ; 1093 1094 \ make fd current 1095 : set-fd ( fd -- error? ) 1096 dup fd>record >busy x@ 0= if ( fd ) 1097 drop true exit ( failed ) 1098 then ( fd ) 1099 to current-fd false ( succeeded ) 1100 ; 1101 1102 \ read next fs block 1103 : file-bread ( adr -- ) 1104 file-bsize ( adr len ) 1105 file-offset@ over / ( adr len blk# ) 1106 file-dnode swap lblk#>bp ( adr len bp ) 1107 read-bp ( ) 1108 ; 1109 1110 \ advance file io stack by n 1111 : fio+ ( # adr len n -- #+n adr+n len-n ) 1112 dup file-offset@ + file-offset! 1113 dup >r - -rot ( len' # adr r: n ) 1114 r@ + -rot ( adr' len' # r: n ) 1115 r> + -rot ( #' adr' len' ) 1116 ; 1117 1118 1119 /max-bsize 5 * 1120 /uber-block + 1121 /dnode 6 * + 1122 /disk-block + ( size ) 1123 \ ugh - sg proms can't free 512k allocations 1124 \ that aren't a multiple of 512k in size 1125 h# 8.0000 roundup ( size' ) 1126 constant alloc-size 1127 1128 1129 : allocate-buffers ( -- ) 1130 alloc-size h# a0.0000 vmem-alloc dup 0= if 1131 " no memory" die 1132 then ( adr ) 1133 dup to temp-space /max-bsize + ( adr ) 1134 dup to dn-cache /max-bsize + ( adr ) 1135 dup to blk-space /max-bsize + ( adr ) 1136 dup to ind-cache /max-bsize + ( adr ) 1137 dup to zap-space /max-bsize + ( adr ) 1138 dup to uber-block /uber-block + ( adr ) 1139 dup to mos-dn /dnode + ( adr ) 1140 dup to obj-dir /dnode + ( adr ) 1141 dup to root-dsl /dnode + ( adr ) 1142 dup to fs-dn /dnode + ( adr ) 1143 dup to zv-dn /dnode + ( adr ) 1144 dup to dnode /dnode + ( adr ) 1145 to gang-space ( ) 1146 1147 \ zero instance buffers 1148 file-records /file-records erase 1149 bootprop-buf /buf-len erase 1150 ; 1151 1152 : release-buffers ( -- ) 1153 temp-space alloc-size mem-free 1154 ; 1155 1156 external 1157 1158 : open ( -- okay? ) 1159 my-args dev-open dup 0= if 1160 exit ( failed ) 1161 then to dev-ih 1162 1163 allocate-buffers 1164 scan-vdev 1165 get-ub 1166 get-root-dsl 1167 true 1168 ; 1169 1170 : open-fs ( fs$ -- okay? ) 1171 fs>rootobj# if ( ) 1172 false ( failed ) 1173 else ( obj# ) 1174 to root-obj# true ( succeeded ) 1175 then ( okay? ) 1176 ; 1177 1178 : close ( -- ) 1179 dev-ih dev-close 1180 0 to dev-ih 1181 release-buffers 1182 ; 1183 1184 : open-file ( path$ -- fd true | false ) 1185 1186 \ open default fs if no open-fs 1187 root-obj# 0= if 1188 prop>rootobj# to root-obj# 1189 then 1190 1191 get-slot if 1192 2drop false exit ( failed ) 1193 then -rot ( fd path$ ) 1194 1195 lookup if ( fd ) 1196 drop false exit ( failed ) 1197 then ( fd ) 1198 1199 dnode fsize over init-fd 1200 true ( fd succeeded ) 1201 ; 1202 1203 : open-volume ( vol$ -- okay? ) 1204 get-slot if 1205 2drop false exit ( failed ) 1206 then -rot ( fd vol$ ) 1207 1208 get-zvol if ( fd ) 1209 drop false exit ( failed ) 1210 then 1211 1212 zvol-size over ( fd size fd ) 1213 zvol-data init-fd ( fd ) 1214 true ( fd succeeded ) 1215 ; 1216 1217 : close-file ( fd -- ) 1218 free-slot ( ) 1219 ; 1220 1221 : size-file ( fd -- size ) 1222 set-fd if 0 else file-size then 1223 ; 1224 1225 : seek-file ( off fd -- off true | false ) 1226 set-fd if ( off ) 1227 drop false exit ( failed ) 1228 then ( off ) 1229 1230 dup file-size x> if ( off ) 1231 drop false exit ( failed ) 1232 then ( off ) 1233 dup file-offset! true ( off succeeded ) 1234 ; 1235 1236 : read-file ( adr len fd -- #read ) 1237 set-fd if ( adr len ) 1238 2drop 0 exit ( 0 ) 1239 then ( adr len ) 1240 1241 \ adjust len if reading past eof 1242 dup file-offset@ + file-size x> if 1243 dup file-offset@ + file-size - - 1244 then 1245 dup 0= if nip exit then 1246 1247 0 -rot ( #read adr len ) 1248 1249 \ initial partial block 1250 file-offset@ file-bsize mod ?dup if ( #read adr len off ) 1251 temp-space file-bread 1252 2dup file-bsize swap - min ( #read adr len off cpy-len ) 1253 2over drop -rot ( #read adr len adr off cpy-len ) 1254 >r temp-space + swap ( #read adr len cpy-src adr r: cpy-len ) 1255 r@ move r> fio+ ( #read' adr' len' ) 1256 then ( #read adr len ) 1257 1258 dup file-bsize / 0 ?do ( #read adr len ) 1259 over file-bread 1260 file-bsize fio+ ( #read' adr' len' ) 1261 loop ( #read adr len ) 1262 1263 \ final partial block 1264 dup if ( #read adr len ) 1265 temp-space file-bread 1266 2dup temp-space -rot move ( #read adr len ) 1267 dup fio+ ( #read' adr' 0 ) 1268 then 2drop ( #read ) 1269 ; 1270 1271 : cinfo-file ( fd -- bsize fsize comp? ) 1272 set-fd if 1273 0 0 0 1274 else 1275 file-bsize file-size ( bsize fsize ) 1276 \ zfs does internal compression 1277 0 ( bsize fsize comp? ) 1278 then 1279 ; 1280 1281 \ read ramdisk fcode at rd-offset 1282 : get-rd ( adr len -- ) 1283 rd-offset dev-ih read-disk 1284 ; 1285 1286 : bootprop 1287 " /" bootprop$ $append 1288 bootfs-obj# (xu.) bootprop$ $append 1289 bootprop$ encode-string " zfs-bootfs" ( propval propname ) 1290 true 1291 ; 1292 1293 1294[ifdef] bigbootblk 1295 : chdir ( dir$ -- ) 1296 current-obj# -rot ( obj# dir$ ) 1297 lookup if ( obj# ) 1298 to current-obj# ( ) 1299 ." no such dir" cr exit 1300 then ( obj# ) 1301 dnode dir? 0= if ( obj# ) 1302 to current-obj# ( ) 1303 ." not a dir" cr exit 1304 then drop ( ) 1305 ; 1306 1307 : dir ( -- ) 1308 current-obj# get-fs-dnode 1309 dnode zap-print 1310 ; 1311[then] 1312 1313finish-device 1314pop-package 1315