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