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 2010 Sun Microsystems, Inc. All rights reserved. 23\ Use is subject to license terms. 24\ 25\ Copyright 2015 Toomas Soome <tsoome@me.com> 26 27 28purpose: ZFS file system support package 29copyright: Copyright 2010 Sun Microsystems, Inc. All Rights Reserved 30 31" /packages" get-package push-package 32 33new-device 34 fs-pkg$ device-name diag-cr? 35 36 0 instance value temp-space 37 38 39 \ 64b ops 40 \ fcode is still 32b on 64b sparc-v9, so 41 \ we need to override some arithmetic ops 42 \ stack ops and logical ops (dup, and, etc) are 64b 43 : xcmp ( x1 x2 -- -1|0|1 ) 44 xlsplit rot xlsplit ( x2.lo x2.hi x1.lo x1.hi ) 45 rot 2dup u< if ( x2.lo x1.lo x1.hi x2.hi ) 46 2drop 2drop -1 ( lt ) 47 else u> if ( x2.lo x1.lo ) 48 2drop 1 ( gt ) 49 else swap 2dup u< if ( x1.lo x2.lo ) 50 2drop -1 ( lt ) 51 else u> if ( ) 52 1 ( gt ) 53 else ( ) 54 0 ( eq ) 55 then then then then ( -1|0|1 ) 56 ; 57 : x< ( x1 x2 -- <? ) xcmp -1 = ; 58 : x> ( x1 x2 -- >? ) xcmp 1 = ; 59\ : x= ( x1 x2 -- =? ) xcmp 0= ; 60 : x<> ( x1 x2 -- <>? ) xcmp 0<> ; 61 : x0= ( x -- 0=? ) xlsplit 0= swap 0= and ; 62 63 /buf-len instance buffer: numbuf 64 65 : (xu.) ( u -- u$ ) 66 numbuf /buf-len + swap ( adr u ) 67 begin 68 d# 10 /mod swap ( adr u' rem ) 69 ascii 0 + ( adr u' c ) 70 rot 1- tuck c! ( u adr' ) 71 swap dup 0= ( adr u done? ) 72 until drop ( adr ) 73 dup numbuf - /buf-len swap - ( adr len ) 74 ; 75 76 \ pool name 77 /buf-len instance buffer: bootprop-buf 78 : bootprop$ ( -- prop$ ) bootprop-buf cscount ; 79 80 \ decompression 81 \ 82 \ uts/common/os/compress.c has a definitive theory of operation comment 83 \ on lzjb, but here's the reader's digest version: 84 \ 85 \ repeated phrases are replaced by referenced to the original 86 \ e.g., 87 \ 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 88 \ becomes 89 \ y a d d a _ 6 11 , _ b l a h 5 10 90 \ where 6 11 means memmove(ptr, ptr - 6, 11) 91 \ 92 \ data is separated from metadata with embedded copymap entries 93 \ every 8 items e.g., 94 \ 0x40 y a d d a _ 6 11 , 0x20 _ b l a h 5 10 95 \ the copymap has a set bit for copy refercences 96 \ and a clear bit for bytes to be copied directly 97 \ 98 \ the reference marks are encoded with match-bits and match-min 99 \ e.g., 100 \ byte[0] = ((mlen - MATCH_MIN) << (NBBY - MATCH_BITS) | (off >> NBBY) 101 \ byte[1] = (uint8_t)off 102 \ 103 104 : pow2 ( n -- 2**n ) 1 swap lshift ; 105 106 \ assume MATCH_BITS=6 and MATCH_MIN=3 107 6 constant mbits 108 3 constant mmin 109 8 mbits - constant mshift 110 d# 16 mbits - pow2 1- constant mmask 111 112 : decode-src ( src -- mlen off ) 113 dup c@ swap 1+ c@ ( c[0] c[1] ) 114 over mshift rshift mmin + ( c[0] c[1] mlen ) 115 -rot swap bwjoin mmask and ( mlen off ) 116 ; 117 118 \ equivalent of memmove(dst, dst - off, len) 119 \ src points to a copy reference to be decoded 120 : mcopy ( dend dst src -- dend dst' ) 121 decode-src ( dend dst mlen off ) 122 2 pick swap - >r ( dent dst mlen r: cpy ) 123 begin 124 1- dup 0>= ( dend dst mlen' any? r: cpy ) 125 2over > and ( dend dst mlen !done? r : cpy ) 126 while ( dend dst mlen r: cpy ) 127 swap r> dup 1+ >r c@ ( dend mlen dst c r: cpy' ) 128 over c! 1+ swap ( dend dst' mlen r: cpy ) 129 repeat ( dend dst' mlen r: cpy ) 130 r> 2drop ( dend dst ) 131 ; 132 133 134 : lzjb ( src dst len -- ) 135 over + swap ( src dend dst ) 136 rot >r ( dend dst r: src ) 137 138 \ setup mask so 1st while iteration fills map 139 0 7 pow2 2swap ( map mask dend dst r: src ) 140 141 begin 2dup > while 142 2swap 1 lshift ( dend dst map mask' r: src ) 143 144 dup 8 pow2 = if 145 \ fetch next copymap 146 2drop ( dend dst r: src ) 147 r> dup 1+ >r c@ 1 ( dend dst map' mask' r: src' ) 148 then ( dend dst map mask r: src' ) 149 150 \ if (map & mask) we hit a copy reference 151 \ else just copy 1 byte 152 2swap 2over and if ( map mask dend dst r: src ) 153 r> dup 2+ >r ( map mask dend dst src r: src' ) 154 mcopy ( map mask dend dst' r: src ) 155 else 156 r> dup 1+ >r c@ ( map mask dend dst c r: src' ) 157 over c! 1+ ( map mask dend dst' r: src ) 158 then 159 repeat ( map mask dend dst r: src ) 160 2drop 2drop r> drop ( ) 161 ; 162 163 \ decode lz4 buffer header, returns src addr and len 164 : lz4_sbuf ( addr -- s_addr s_len ) 165 dup C@ 8 lshift swap 1+ ( byte0 addr++ ) 166 dup C@ ( byte0 addr byte1 ) 167 rot ( addr byte1 byte0 ) 168 or d# 16 lshift swap 1+ ( d addr++ ) 169 170 dup C@ 8 lshift ( d addr byte2 ) 171 swap 1+ ( d byte2 addr++ ) 172 dup C@ swap 1+ ( d byte2 byte3 addr++ ) 173 -rot ( d s_addr byte2 byte3 ) 174 or ( d s_addr d' ) 175 rot ( s_addr d' d ) 176 or ( s_addr s_len ) 177 ; 178 179 4 constant STEPSIZE 180 8 constant COPYLENGTH 181 5 constant LASTLITERALS 182 4 constant ML_BITS 183 d# 15 constant ML_MASK \ (1<<ML_BITS)-1 184 4 constant RUN_BITS \ 8 - ML_BITS 185 d# 15 constant RUN_MASK \ (1<<RUN_BITS)-1 186 187 \ A32(d) = A32(s); d+=4; s+=4 188 : lz4_copystep ( dest source -- dest' source') 189 2dup swap 4 move 190 swap 4 + 191 swap 4 + ( dest+4 source+4 ) 192 ; 193 194 \ do { LZ4_COPYPACKET(s, d) } while (d < e); 195 : lz4_copy ( e d s -- e d' s' ) 196 begin ( e d s ) 197 lz4_copystep 198 lz4_copystep ( e d s ) 199 over ( e d s d ) 200 3 pick < 0= 201 until 202 ; 203 204 \ lz4 decompress translation from C code 205 \ could use some factorisation 206 : lz4 ( src dest len -- ) 207 swap dup >r swap \ save original dest to return stack. 208 rot ( dest len src ) 209 lz4_sbuf ( dest len s_buf s_len ) 210 over + ( dest len s_buf s_end ) 211 2swap ( s_buf s_end dest len ) 212 over + ( s_buf s_end dest dest_end ) 213 2swap ( dest dest_end s_buf s_end ) 214 215 \ main loop 216 begin 2dup < while 217 swap dup C@ ( dest dest_end s_end s_buf token ) 218 swap CHAR+ swap ( dest dest_end s_end s_buf++ token ) 219 dup ML_BITS rshift ( dest dest_end s_end s_buf token length ) 220 >r rot rot r> ( dest dest_end token s_end s_buf length ) 221 dup RUN_MASK = if 222 d# 255 begin ( dest dest_end token s_end s_buf length s ) 223 swap ( dest dest_end token s_end s_buf s length ) 224 >r >r ( ... R: length s ) 225 2dup > ( dest dest_end token s_end s_buf flag ) 226 r@ d# 255 = and ( dest dest_end token s_end s_buf flag R: length s ) 227 r> swap r> swap ( dest dest_end token s_end s_buf s length flag ) 228 >r swap r> ( dest dest_end token s_end s_buf length s flag ) 229 while 230 drop >r ( dest dest_end token s_end s_buf R: length ) 231 dup c@ swap CHAR+ ( dest dest_end token s_end s s_buf++ ) 232 swap ( dest dest_end token s_end s_buf s ) 233 dup ( dest dest_end token s_end s_buf s s ) 234 r> + swap ( dest dest_end token s_end s_buf length s ) 235 repeat 236 drop ( dest dest_end token s_end s_buf length ) 237 then 238 239 -rot ( dest dest_end token length s_end s_buf ) 240 swap >r >r ( dest dest_end token length R: s_end s_buf ) 241 swap >r ( dest dest_end length R: s_end s_buf token ) 242 rot ( dest_end length dest ) 243 2dup + ( dest_end length dest cpy ) 244 245 2dup > if ( dest > cpy ) 246 " lz4 overflow" die 247 then 248 249 3 pick COPYLENGTH - over < ( dest_end length dest cpy flag ) 250 3 pick ( dest_end length dest cpy flag length ) 251 r> ( dest_end length dest cpy flag length token ) 252 r> ( dest_end length dest cpy flag length token s_buf R: s_end ) 253 rot ( dest_end length dest cpy flag token s_buf length ) 254 over + ( dest_end length dest cpy flag token s_buf length+s_buf ) 255 r@ COPYLENGTH - > ( dest_end length dest cpy flag token s_buf flag ) 256 swap >r ( dest_end length dest cpy flag token flag R: s_end s_buf ) 257 swap >r ( dest_end length dest cpy flag flag R: s_end s_buf token ) 258 or if ( dest_end length dest cpy R: s_end s_buf token ) 259 260 3 pick over swap > if 261 " lz4 write beyond buffer end" die ( write beyond the dest end ) 262 then ( dest_end length dest cpy ) 263 264 2 pick ( dest_end length dest cpy length ) 265 r> r> swap ( dest_end length dest cpy length s_buf token R: s_end ) 266 r> ( dest_end length dest cpy length s_buf token s_end ) 267 swap >r >r ( dest_end length dest cpy length s_buf R: token s_end ) 268 269 swap over + ( dest_end length dest cpy s_buf s_buf+length ) 270 r@ > if ( dest_end length dest cpy s_buf R: token s_end ) 271 " lz4 read beyond source" die \ read beyond source buffer 272 then 273 274 nip ( dest_end length dest s_buf R: token s_end ) 275 >r ( dest_end length dest R: token s_end s_buf ) 276 over r@ ( dest_end length dest length s_buf ) 277 -rot move ( dest_end length ) 278 279 r> + r> r> drop < if 280 " lz4 format violation" die \ LZ4 format violation 281 then 282 283 r> drop \ drop original dest 284 drop 285 exit \ parsing done 286 then 287 288 swap ( dest_end length cpy dest R: s_end s_buf token ) 289 r> r> swap >r ( dest_end length cpy dest s_buf R: s_end token ) 290 291 lz4_copy ( dest_end length cpy dest s_buf) 292 293 -rot ( dest_end length s_buf cpy dest ) 294 over - ( dest_end length s_buf cpy dest-cpy ) 295 rot ( dest_end length cpy dest-cpy s_buf ) 296 swap - ( dest_end length cpy s_buf ) 297 298 dup C@ swap ( dest_end length cpy b s_buf ) 299 dup 1+ C@ 8 lshift ( dest_end length cpy b s_buf w ) 300 rot or ( dest_end length cpy s_buf w ) 301 2 pick swap - ( dest_end length cpy s_buf ref ) 302 swap 2 + ( dest_end length cpy ref s_buf+2 ) 303 \ note: cpy is also dest, remember to save it 304 -rot ( dest_end length s_buf cpy ref ) 305 dup ( dest_end length s_buf cpy ref ref ) 306 307 \ now we need original dest 308 r> r> swap r@ ( dest_end length s_buf cpy ref ref s_end token dest ) 309 -rot swap >r >r 310 < if 311 " lz4 reference outside buffer" die \ reference outside dest buffer 312 then ( dest_end length s_buf op ref ) 313 314 2swap ( dest_end op ref length s_buf ) 315 swap ( dest_end op ref s_buf length R: dest s_end token ) 316 317 \ get matchlength 318 drop r> ML_MASK and ( dest_end op ref s_buf length R: dest s_end ) 319 dup ML_MASK = if ( dest_end op ref s_buf length R: dest s_end ) 320 -1 \ flag to top 321 begin 322 rot ( dest_end op ref length flag s_buf ) 323 dup r@ < ( dest_end op ref length flag s_buf flag ) 324 rot and ( dest_end op ref length s_buf flag ) 325 while 326 dup c@ ( dest_end op ref length s_buf s ) 327 swap 1+ ( dest_end op ref length s s_buf++ ) 328 -rot ( dest_end op ref s_buf length s ) 329 swap over + swap ( dest_end op ref s_buf length+s s ) 330 d# 255 = 331 repeat 332 swap 333 then ( dest_end op ref s_buf length R: dest s_end ) 334 335 2swap ( dest_end s_buf length op ref ) 336 337 \ copy repeated sequence 338 2dup - STEPSIZE < if ( dest_end s_buf length op ref ) 339 \ 4 times *op++ = *ref++; 340 dup c@ >r ( dest_end s_buf length op ref R: C ) 341 CHAR+ swap ( dest_end s_buf length ref++ op ) 342 dup r> swap c! CHAR+ swap ( dest_end s_buf length op ref ) 343 dup c@ >r ( dest_end s_buf length op ref R: C ) 344 CHAR+ swap ( dest_end s_buf length ref++ op ) 345 dup r> swap c! CHAR+ swap ( dest_end s_buf length op ref ) 346 dup c@ >r ( dest_end s_buf length op ref R: C ) 347 CHAR+ swap ( dest_end s_buf length ref++ op ) 348 dup r> swap c! CHAR+ swap ( dest_end s_buf length op ref ) 349 dup c@ >r ( dest_end s_buf length op ref R: C ) 350 CHAR+ swap ( dest_end s_buf length ref++ op ) 351 dup r> swap c! CHAR+ swap ( dest_end s_buf length op ref ) 352 2dup - ( dest_end s_buf length op ref op-ref ) 353 case 354 1 of 3 endof 355 2 of 2 endof 356 3 of 3 endof 357 0 358 endcase 359 - \ ref -= dec 360 2dup swap 4 move ( dest_end s_buf length op ref ) 361 swap STEPSIZE 4 - + 362 swap ( dest_end s_buf length op ref ) 363 else 364 lz4_copystep ( dest_end s_buf length op ref ) 365 then 366 -rot ( dest_end s_buf ref length op ) 367 swap over ( dest_end s_buf ref op length op ) 368 + STEPSIZE 4 - - ( dest_end s_buf ref op cpy R: dest s_end ) 369 370 \ if cpy > oend - COPYLENGTH 371 4 pick COPYLENGTH - ( dest_end s_buf ref op cpy oend-COPYLENGTH ) 372 2dup > if ( dest_end s_buf ref op cpy oend-COPYLENGTH ) 373 swap ( dest_end s_buf ref op oend-COPYLENGTH cpy ) 374 375 5 pick over < if 376 " lz4 write outside buffer" die \ write outside of dest buffer 377 then ( dest_end s_buf ref op oend-COPYLENGTH cpy ) 378 379 >r ( dest_end s_buf ref op oend-COPYLENGTH R: dest s_end cpy ) 380 -rot swap ( dest_end s_buf oend-COPYLENGTH op ref ) 381 lz4_copy ( dest_end s_buf oend-COPYLENGTH op ref ) 382 rot drop swap r> ( dest_end s_buf ref op cpy ) 383 begin 384 2dup < 385 while 386 >r ( dest_end s_buf ref op R: cpy ) 387 over ( dest_end s_buf ref op ref ) 388 c@ ( dest_end s_buf ref op C ) 389 over c! ( dest_end s_buf ref op ) 390 >r 1+ r> 1+ r> ( dest_end s_buf ref++ op++ cpy ) 391 repeat 392 393 nip ( dest_end s_buf ref op ) 394 dup 4 pick = if 395 \ op == dest_end we are done, cleanup 396 r> r> 2drop 2drop 2drop 397 exit 398 then 399 ( dest_end s_buf ref op R: dest s_end ) 400 nip ( dest_end s_buf op ) 401 else 402 drop ( dest_end s_buf ref op cpy R: dest s_end) 403 -rot ( dest_end s_buf cpy ref op ) 404 swap ( dest_end s_buf cpy op ref ) 405 lz4_copy 406 2drop ( dest_end s_buf op ) 407 then 408 409 -rot r> ( op dest_end s_buf s_end R: dest ) 410 repeat 411 412 r> drop 413 2drop 414 2drop 415 ; 416 417 \ 418 \ ZFS block (SPA) routines 419 \ 420 421 1 constant def-comp# 422 2 constant no-comp# 423 3 constant lzjb-comp# 424 d# 15 constant lz4-comp# 425 426 h# 2.0000 constant /max-bsize 427 d# 512 constant /disk-block 428 d# 128 constant /blkp 429 430 alias /gang-block /disk-block 431 432 \ the ending checksum is larger than 1 byte, but that 433 \ doesn't affect the math here 434 /gang-block 1- 435 /blkp / constant #blks/gang 436 437 : blk_offset ( bp -- n ) h# 8 + x@ -1 h# 7fff.ffff lxjoin and ; 438 : blk_gang ( bp -- n ) h# 8 + x@ xlsplit nip d# 31 rshift ; 439 : blk_comp ( bp -- n ) h# 33 + c@ ; 440 : blk_psize ( bp -- n ) h# 34 + w@ ; 441 : blk_lsize ( bp -- n ) h# 36 + w@ ; 442 : blk_birth ( bp -- n ) h# 50 + x@ ; 443 444 0 instance value dev-ih 445 0 instance value blk-space 446 0 instance value gang-space 447 448 : foff>doff ( fs-off -- disk-off ) /disk-block * h# 40.0000 + ; 449 : fsz>dsz ( fs-size -- disk-size ) 1+ /disk-block * ; 450 451 : bp-dsize ( bp -- dsize ) blk_psize fsz>dsz ; 452 : bp-lsize ( bp -- lsize ) blk_lsize fsz>dsz ; 453 454 : (read-dva) ( adr len dva -- ) 455 blk_offset foff>doff dev-ih read-disk 456 ; 457 458 : gang-read ( adr len bp gb-adr -- ) tokenizer[ reveal ]tokenizer 459 460 \ read gang block 461 tuck /gang-block rot (read-dva) ( adr len gb-adr ) 462 463 \ loop through indirected bp's 464 dup /blkp #blks/gang * ( adr len gb-adr bp-list bp-list-len ) 465 bounds do ( adr len gb-adr ) 466 i blk_offset x0= ?leave 467 468 \ calc subordinate read len 469 over i bp-dsize min ( adr len gb-adr sub-len ) 470 2swap swap ( gb-adr sub-len len adr ) 471 472 \ nested gang block - recurse with new gang block area 473 i blk_gang if 474 2swap ( len adr gb-adr sub-len ) 475 3dup swap /gang-block + ( len adr gb-adr sub-len adr sub-len gb-adr' ) 476 i swap gang-read ( len adr gb-adr sub-len ) 477 2swap ( gb-adr sub-len len adr ) 478 else 479 3dup nip swap ( gb-adr sub-len len adr adr sub-len ) 480 i (read-dva) ( gb-adr sub-len len adr ) 481 then ( gb-adr sub-len len adr ) 482 483 \ adjust adr,len and check if done 484 -rot over - ( gb-adr adr sub-len len' ) 485 -rot + swap ( gb-adr adr' len' ) 486 dup 0= ?leave 487 rot ( adr' len' gb-adr ) 488 /blkp +loop 489 3drop ( ) 490 ; 491 492 : read-dva ( adr len dva -- ) 493 dup blk_gang if 494 gang-space gang-read 495 else 496 (read-dva) 497 then 498 ; 499 500 \ block read that check for holes, gangs, compression, etc 501 : read-bp ( adr len bp -- ) 502 \ sparse block? 503 dup x@ x0= ( addr len bp flag0 ) 504 swap dup 8 + x@ x0= ( addr len flag0 bp flag1 ) 505 rot ( addr len bp flag1 flag0 ) 506 and if 507 drop erase exit ( ) 508 then 509 510 \ no compression? 511 dup blk_comp no-comp# = if 512 read-dva exit ( ) 513 then 514 515 \ lzjb? 516 dup blk_comp lzjb-comp# = if 517 \ read into blk-space and de-compress 518 blk-space over bp-dsize ( adr len bp blk-adr rd-len ) 519 rot read-dva ( adr len ) 520 blk-space -rot lzjb ( ) 521 exit 522 then 523 524 dup blk_comp dup lz4-comp# <> ( adr len bp comp lz4? ) 525 swap def-comp# <> and if ( adr len bp ) 526 dup hex . ." BP: " 527 blk_comp decimal . 528 ." : bug, unknown compression algorithm: " 529 " only lzjb and lz4 supported" die 530 then 531 532 \ read into blk-space and de-compress 533 blk-space over bp-dsize ( adr len bp blk-adr rd-len ) 534 rot read-dva ( adr len ) 535 blk-space -rot lz4 ( ) 536 ; 537 538 \ 539 \ ZFS vdev routines 540 \ 541 542 h# 1.c000 constant /nvpairs 543 h# 4000 constant nvpairs-off 544 545 \ 546 \ xdr packed nvlist 547 \ 548 \ 12B header 549 \ array of xdr packed nvpairs 550 \ 4B encoded nvpair size 551 \ 4B decoded nvpair size 552 \ 4B name string size 553 \ name string 554 \ 4B data type 555 \ 4B # of data elements 556 \ data 557 \ 8B of 0 558 \ 559 d# 12 constant /nvhead 560 561 : >nvsize ( nv -- size ) l@ ; 562 : >nvname ( nv -- name$ ) 563 /l 2* + dup /l + swap l@ 564 ; 565 : >nvdata ( nv -- data ) 566 >nvname + /l roundup 567 ; 568 569 \ convert nvdata to 64b int or string 570 : nvdata>x ( nvdata -- x ) 571 /l 2* + ( ptr ) 572 dup /l + l@ swap l@ ( x.lo x.hi ) 573 lxjoin ( x ) 574 ; 575 alias nvdata>$ >nvname 576 577 : nv-lookup ( nv name$ -- nvdata false | true ) 578 rot /nvhead + ( name$ nvpair ) 579 begin dup >nvsize while 580 dup >r >nvname ( name$ nvname$ r: nvpair ) 581 2over $= if ( name$ r: nvpair ) 582 2drop r> >nvdata ( nvdata ) 583 false exit ( nvdata found ) 584 then ( name$ r: nvpair ) 585 r> dup >nvsize + ( name$ nvpair' ) 586 repeat 587 3drop true ( not-found ) 588 ; 589 590 : scan-vdev ( -- ) 591 temp-space /nvpairs nvpairs-off ( adr len off ) 592 dev-ih read-disk ( ) 593 temp-space " txg" nv-lookup if 594 " no txg nvpair" die 595 then nvdata>x ( txg ) 596 x0= if 597 " detached mirror" die 598 then ( ) 599 temp-space " name" nv-lookup if 600 " no name nvpair" die 601 then nvdata>$ ( pool$ ) 602 bootprop-buf swap move ( ) 603 ; 604 605 606 \ 607 \ ZFS ueber-block routines 608 \ 609 610 d# 1024 constant /uber-block 611 d# 128 constant #ub/label 612 #ub/label /uber-block * constant /ub-ring 613 h# 2.0000 constant ubring-off 614 615 : ub_magic ( ub -- n ) x@ ; 616 : ub_txg ( ub -- n ) h# 10 + x@ ; 617 : ub_timestamp ( ub -- n ) h# 20 + x@ ; 618 : ub_rootbp ( ub -- p ) h# 28 + ; 619 620 0 instance value uber-block 621 622 : ub-cmp ( ub1 ub2 -- best-ub ) 623 624 \ ub1 wins if ub2 isn't valid 625 dup ub_magic h# 00bab10c x<> if 626 drop exit ( ub1 ) 627 then 628 629 \ if ub1 is 0, ub2 wins by default 630 over 0= if nip exit then ( ub2 ) 631 632 \ 2 valid ubs, compare transaction groups 633 over ub_txg over ub_txg ( ub1 ub2 txg1 txg2 ) 634 2dup x< if 635 2drop nip exit ( ub2 ) 636 then ( ub1 ub2 txg1 txg2 ) 637 x> if drop exit then ( ub1 ) 638 639 \ same txg, check timestamps 640 over ub_timestamp over ub_timestamp x> if 641 nip ( ub2 ) 642 else 643 drop ( ub1 ) 644 then 645 ; 646 647 \ find best uber-block in ring, and copy it to uber-block 648 : get-ub ( -- ) 649 temp-space /ub-ring ubring-off ( adr len off ) 650 dev-ih read-disk ( ) 651 0 temp-space /ub-ring ( null-ub adr len ) 652 bounds do ( ub ) 653 i ub-cmp ( best-ub ) 654 /uber-block +loop 655 656 \ make sure we found a valid ub 657 dup 0= if " no ub found" die then 658 659 uber-block /uber-block move ( ) 660 ; 661 662 663 \ 664 \ ZFS dnode (DMU) routines 665 \ 666 667 d# 44 constant ot-sa# 668 669 d# 512 constant /dnode 670 671 : dn_indblkshift ( dn -- n ) h# 1 + c@ ; 672 : dn_nlevels ( dn -- n ) h# 2 + c@ ; 673 : dn_bonustype ( dn -- n ) h# 4 + c@ ; 674 : dn_datablkszsec ( dn -- n ) h# 8 + w@ ; 675 : dn_bonuslen ( dn -- n ) h# a + w@ ; 676 : dn_blkptr ( dn -- p ) h# 40 + ; 677 : dn_bonus ( dn -- p ) h# c0 + ; 678 : dn_spill ( dn -- p ) h# 180 + ; 679 680 0 instance value dnode 681 682 \ indirect cache 683 \ 684 \ ind-cache is a 1 block indirect block cache from dnode ic-dn 685 \ 686 \ ic-bp and ic-bplim point into the ic-dn's block ptr array, 687 \ either in dn_blkptr or in ind-cache ic-bp is the ic-blk#'th 688 \ block ptr, and ic-bplim is limit of the current bp array 689 \ 690 \ the assumption is that reads will be sequential, so we can 691 \ just increment ic-bp 692 \ 693 0 instance value ind-cache 694 0 instance value ic-dn 695 0 instance value ic-blk# 696 0 instance value ic-bp 697 0 instance value ic-bplim 698 699 : dn-bsize ( dn -- bsize ) dn_datablkszsec /disk-block * ; 700 : dn-indsize ( dn -- indsize ) dn_indblkshift pow2 ; 701 : dn-indmask ( dn -- mask ) dn-indsize 1- ; 702 703 \ recursively climb the block tree from the leaf to the root 704 : blk@lvl>bp ( dn blk# lvl -- bp ) tokenizer[ reveal ]tokenizer 705 >r /blkp * over dn_nlevels ( dn bp-off #lvls r: lvl ) 706 707 \ at top, just add dn_blkptr 708 r@ = if ( dn bp-off r: lvl ) 709 swap dn_blkptr + ( bp r: lvl ) 710 r> drop exit ( bp ) 711 then ( dn bp-off r: lvl ) 712 713 \ shift bp-off down and find parent indir blk 714 2dup over dn_indblkshift rshift ( dn bp-off dn blk# r: lvl ) 715 r> 1+ blk@lvl>bp ( dn bp-off bp ) 716 717 \ read parent indir blk and index 718 rot tuck dn-indsize ( bp-off dn bp len ) 719 ind-cache swap rot read-bp ( bp-off dn ) 720 dn-indmask and ( bp-off' ) 721 ind-cache + ( bp ) 722 ; 723 724 \ return end of current bp array 725 : bplim ( dn bp -- bp-lim ) 726 over dn_nlevels 1 = if 727 drop dn_blkptr ( bp0 ) 728 3 /blkp * + ( bplim ) 729 else 730 1+ swap dn-indsize ( bp+1 indsz ) 731 roundup ( bplim ) 732 then 733 ; 734 735 \ return the lblk#'th block ptr from dnode 736 : lblk#>bp ( dn blk# -- bp ) 737 2dup ( dn blk# dn blk# ) 738 ic-blk# <> swap ic-dn <> or ( dn blk# cache-miss? ) 739 ic-bp ic-bplim = ( dn blk# cache-miss? cache-empty? ) 740 or if ( dn blk# ) 741 2dup 1 blk@lvl>bp ( dn blk# bp ) 742 dup to ic-bp ( dn blk# bp ) 743 swap to ic-blk# ( dn bp ) 744 2dup bplim to ic-bplim ( dn bp ) 745 over to ic-dn 746 then 2drop ( ) 747 ic-blk# 1+ to ic-blk# 748 ic-bp dup /blkp + to ic-bp ( bp ) 749 ; 750 751 752 \ 753 \ ZFS attribute (ZAP) routines 754 \ 755 756 1 constant fzap# 757 3 constant uzap# 758 759 d# 64 constant /uzap 760 761 d# 24 constant /lf-chunk 762 d# 21 constant /lf-arr 763 h# ffff constant chain-end# 764 765 h# 100 constant /lf-buf 766 /lf-buf instance buffer: leaf-value 767 /lf-buf instance buffer: leaf-name 768 769 : +le ( len off -- n ) + w@ ; 770 : le_next ( le -- n ) h# 2 +le ; 771 : le_name_chunk ( le -- n ) h# 4 +le ; 772 : le_name_length ( le -- n ) h# 6 +le ; 773 : le_value_chunk ( le -- n ) h# 8 +le ; 774 : le_value_length ( le -- n ) h# a +le ; 775 776 : la_array ( la -- adr ) 1+ ; 777 : la_next ( la -- n ) h# 16 + w@ ; 778 779 0 instance value zap-space 780 781 \ setup leaf hash bounds 782 : >leaf-hash ( dn lh -- hash-adr /hash ) 783 /lf-chunk 2* + ( dn hash-adr ) 784 \ size = (bsize / 32) * 2 785 swap dn-bsize 4 rshift ( hash-adr /hash ) 786 ; 787 : >leaf-chunks ( lf -- ch0 ) >leaf-hash + ; 788 789 \ convert chunk # to leaf chunk 790 : ch#>lc ( dn ch# -- lc ) 791 /lf-chunk * ( dn lc-off ) 792 swap zap-space >leaf-chunks ( lc-off ch0 ) 793 + ( lc ) 794 ; 795 796 \ assemble chunk chain into single buffer 797 : get-chunk-data ( dn ch# adr -- ) 798 dup >r /lf-buf erase ( dn ch# r: adr ) 799 begin 800 2dup ch#>lc nip ( dn la r: adr ) 801 dup la_array ( dn la la-arr r: adr ) 802 r@ /lf-arr move ( dn la r: adr ) 803 r> /lf-arr + >r ( dn la r: adr' ) 804 la_next dup chain-end# = ( dn la-ch# end? r: adr ) 805 until r> 3drop ( ) 806 ; 807 808 \ get leaf entry's name 809 : entry-name$ ( dn le -- name$ ) 810 2dup le_name_chunk ( dn le dn la-ch# ) 811 leaf-name get-chunk-data ( dn le ) 812 nip le_name_length 1- ( len ) 813 leaf-name swap ( name$ ) 814 ; 815 816 \ return entry value as int 817 : entry-int-val ( dn le -- n ) 818 le_value_chunk ( dn la-ch# ) 819 leaf-value get-chunk-data ( ) 820 leaf-value x@ ( n ) 821 ; 822 823 824[ifdef] strlookup 825 \ get leaf entry's value as string 826 : entry-val$ ( dn le -- val$ ) 827 2dup le_value_chunk ( dn le dn la-ch# ) 828 leaf-value get-chunk-data ( dn le ) 829 nip le_value_length ( len ) 830 leaf-value swap ( name$ ) 831 ; 832[then] 833 834 \ apply xt to entry 835 : entry-apply ( xt dn le -- xt dn false | ??? true ) 836 over >r ( xt dn le r: dn ) 837 rot dup >r execute if ( ??? r: xt dn ) 838 r> r> 2drop true ( ??? true ) 839 else ( ) 840 r> r> false ( xt dn false ) 841 then 842 ; 843 844 \ apply xt to every entry in chain 845 : chain-apply ( xt dn ch# -- xt dn false | ??? true ) 846 begin 847 2dup ch#>lc nip ( xt dn le ) 848 dup >r entry-apply if ( ??? r: le ) 849 r> drop true exit ( ??? found ) 850 then ( xt dn r: le ) 851 r> le_next ( xt dn ch# ) 852 dup chain-end# = ( xt dn ch# end? ) 853 until drop ( xt dn ) 854 false ( xt dn false ) 855 ; 856 857 \ apply xt to every entry in leaf 858 : leaf-apply ( xt dn blk# -- xt dn false | ??? true ) 859 860 \ read zap leaf into zap-space 861 2dup lblk#>bp ( xt dn blk# bp ) 862 nip over dn-bsize zap-space ( xt dn bp len adr ) 863 swap rot read-bp ( xt dn ) 864 865 \ call chunk-look for every valid chunk list 866 dup zap-space >leaf-hash ( xt dn hash-adr /hash ) 867 bounds do ( xt dn ) 868 i w@ dup chain-end# <> if ( xt dn ch# ) 869 chain-apply if ( ??? ) 870 unloop true exit ( ??? found ) 871 then ( xt dn ) 872 else drop then ( xt dn ) 873 /w +loop 874 false ( xt dn not-found ) 875 ; 876 877 \ apply xt to every entry in fzap 878 : fzap-apply ( xt dn fz -- ??? not-found? ) 879 880 \ blk# 1 is always the 1st leaf 881 >r 1 leaf-apply if ( ??? r: fz ) 882 r> drop true exit ( ??? found ) 883 then r> ( xt dn fz ) 884 885 \ call leaf-apply on every non-duplicate hash entry 886 \ embedded hash is in 2nd half of fzap block 887 over dn-bsize tuck + ( xt dn bsize hash-eadr ) 888 swap 2dup 2/ - ( xt dn hash-eadr bsize hash-adr ) 889 nip do ( xt dn ) 890 i x@ dup 1 <> if ( xt dn blk# ) 891 leaf-apply if ( ??? ) 892 unloop true exit ( ??? found ) 893 then ( xt dn ) 894 else drop then ( xt dn ) 895 /x +loop 896 2drop false ( not-found ) 897 ; 898 899 : mze_value ( uz -- n ) x@ ; 900 : mze_name ( uz -- p ) h# e + ; 901 902 : uzap-name$ ( uz -- name$ ) mze_name cscount ; 903 904 \ apply xt to each entry in micro-zap 905 : uzap-apply ( xt uz len -- ??? not-found? ) 906 bounds do ( xt ) 907 i swap dup >r ( uz xt r: xt ) 908 execute if ( ??? r: xt ) 909 r> drop ( ??? ) 910 unloop true exit ( ??? found ) 911 then r> ( xt ) 912 /uzap +loop 913 drop false ( not-found ) 914 ; 915 916 \ match by name 917 : fz-nmlook ( prop$ dn le -- prop$ false | prop$ dn le true ) 918 2dup entry-name$ ( prop$ dn le name$ ) 919 2rot 2swap ( dn le prop$ name$ ) 920 2over $= if ( dn le prop$ ) 921 2swap true ( prop$ dn le true ) 922 else ( dn le prop$ ) 923 2swap 2drop false ( prop$ false ) 924 then ( prop$ false | prop$ dn le true ) 925 ; 926 927 \ match by name 928 : uz-nmlook ( prop$ uz -- prop$ false | prop$ uz true ) 929 dup >r uzap-name$ ( prop$ name$ r: uz ) 930 2over $= if ( prop$ r: uz ) 931 r> true ( prop$ uz true ) 932 else ( prop$ r: uz ) 933 r> drop false ( prop$ false ) 934 then ( prop$ false | prop$ uz true ) 935 ; 936 937 : zap-type ( zp -- n ) h# 7 + c@ ; 938 : >uzap-ent ( adr -- ent ) h# 40 + ; 939 940 \ read zap block into temp-space 941 : get-zap ( dn -- zp ) 942 dup 0 lblk#>bp ( dn bp ) 943 swap dn-bsize ( bp len ) 944 temp-space swap ( bp adr len ) 945 rot read-bp ( ) 946 temp-space ( zp ) 947 ; 948 949 \ find prop in zap dnode 950 : zap-lookup ( dn prop$ -- [ n ] not-found? ) 951 rot dup get-zap ( prop$ dn zp ) 952 dup zap-type case 953 uzap# of 954 >uzap-ent swap dn-bsize ( prop$ uz len ) 955 ['] uz-nmlook -rot ( prop$ xt uz len ) 956 uzap-apply if ( prop$ uz ) 957 mze_value -rot 2drop ( n ) 958 false ( n found ) 959 else ( prop$ ) 960 2drop true ( !found ) 961 then ( [ n ] not-found? ) 962 endof 963 fzap# of 964 ['] fz-nmlook -rot ( prop$ xt dn fz ) 965 fzap-apply if ( prop$ dn le ) 966 entry-int-val ( prop$ n ) 967 -rot 2drop false ( n found ) 968 else ( prop$ ) 969 2drop true ( !found ) 970 then ( [ n ] not-found? ) 971 endof 972 3drop 2drop true ( !found ) 973 endcase ( [ n ] not-found? ) 974 ; 975 976[ifdef] strlookup 977 : zap-lookup-str ( dn prop$ -- [ val$ ] not-found? ) 978 rot dup get-zap ( prop$ dn zp ) 979 dup zap-type fzap# <> if ( prop$ dn zp ) 980 2drop 2drop true exit ( !found ) 981 then ( prop$ dn zp ) 982 ['] fz-nmlook -rot ( prop$ xt dn fz ) 983 fzap-apply if ( prop$ dn le ) 984 entry-val$ 2swap 2drop false ( val$ found ) 985 else ( prop$ ) 986 2drop true ( !found ) 987 then ( [ val$ ] not-found? ) 988 ; 989[then] 990 991 : fz-print ( dn le -- false ) 992 entry-name$ type cr false 993 ; 994 995 : uz-print ( uz -- false ) 996 uzap-name$ type cr false 997 ; 998 999 : zap-print ( dn -- ) 1000 dup get-zap ( dn zp ) 1001 dup zap-type case 1002 uzap# of 1003 >uzap-ent swap dn-bsize ( uz len ) 1004 ['] uz-print -rot ( xt uz len ) 1005 uzap-apply ( false ) 1006 endof 1007 fzap# of 1008 ['] fz-print -rot ( xt dn fz ) 1009 fzap-apply ( false ) 1010 endof 1011 3drop false ( false ) 1012 endcase ( false ) 1013 drop ( ) 1014 ; 1015 1016 1017 \ 1018 \ ZFS object set (DSL) routines 1019 \ 1020 1021 1 constant pool-dir# 1022 1023 : dd_head_dataset_obj ( dd -- n ) h# 8 + x@ ; 1024 : dd_child_dir_zapobj ( dd -- n ) h# 20 + x@ ; 1025 1026 : ds_snapnames_zapobj ( ds -- n ) h# 20 + x@ ; 1027 : ds_bp ( ds -- p ) h# 80 + ; 1028 1029 0 instance value mos-dn 1030 0 instance value obj-dir 1031 0 instance value root-dsl 1032 0 instance value fs-dn 1033 1034 \ dn-cache contains dc-dn's contents at dc-blk# 1035 \ dc-dn will be either mos-dn or fs-dn 1036 0 instance value dn-cache 1037 0 instance value dc-dn 1038 0 instance value dc-blk# 1039 1040 alias >dsl-dir dn_bonus 1041 alias >dsl-ds dn_bonus 1042 1043 : #dn/blk ( dn -- n ) dn-bsize /dnode / ; 1044 1045 \ read block into dn-cache 1046 : get-dnblk ( dn blk# -- ) 1047 lblk#>bp dn-cache swap ( adr bp ) 1048 dup bp-lsize swap read-bp ( ) 1049 ; 1050 1051 \ read obj# from objset dir dn into dnode 1052 : get-dnode ( dn obj# -- ) 1053 1054 \ check dn-cache 1055 2dup swap #dn/blk /mod ( dn obj# off# blk# ) 1056 swap >r nip ( dn blk# r: off# ) 1057 2dup dc-blk# <> ( dn blk# dn !blk-hit? r: off# ) 1058 swap dc-dn <> or if ( dn blk# r: off# ) 1059 \ cache miss, fill from dir 1060 2dup get-dnblk 1061 over to dc-dn 1062 dup to dc-blk# 1063 then ( dn blk# r: off# ) 1064 1065 \ index and copy 1066 2drop r> /dnode * ( off ) 1067 dn-cache + ( dn-adr ) 1068 dnode /dnode move ( ) 1069 ; 1070 1071 \ read meta object set from uber-block 1072 : get-mos ( -- ) 1073 mos-dn uber-block ub_rootbp ( adr bp ) 1074 dup bp-lsize swap read-bp 1075 ; 1076 1077 : get-mos-dnode ( obj# -- ) 1078 mos-dn swap get-dnode 1079 ; 1080 1081 \ get root dataset 1082 : get-root-dsl ( -- ) 1083 1084 \ read MOS 1085 get-mos 1086 1087 \ read object dir 1088 pool-dir# get-mos-dnode 1089 dnode obj-dir /dnode move 1090 1091 \ read root dataset 1092 obj-dir " root_dataset" zap-lookup if 1093 " no root_dataset" die 1094 then ( obj# ) 1095 get-mos-dnode ( ) 1096 dnode root-dsl /dnode move 1097 ; 1098 1099 \ find snapshot of given dataset 1100 : snap-look ( snap$ ds-obj# -- [ss-obj# ] not-found? ) 1101 get-mos-dnode dnode >dsl-ds ( snap$ ds ) 1102 ds_snapnames_zapobj get-mos-dnode ( snap$ ) 1103 dnode -rot zap-lookup ( [ss-obj# ] not-found? ) 1104 ; 1105 1106 \ dsl dir to dataset 1107 : dir>ds ( dn -- obj# ) >dsl-dir dd_head_dataset_obj ; 1108 1109 \ look thru the dsl hierarchy for path 1110 \ this looks almost exactly like a FS directory lookup 1111 : dsl-lookup ( path$ -- [ ds-obj# ] not-found? ) 1112 root-dsl >r ( path$ r: root-dn ) 1113 begin 1114 ascii / left-parse-string ( path$ file$ r: dn ) 1115 dup while 1116 1117 \ get child dir zap dnode 1118 r> >dsl-dir dd_child_dir_zapobj ( path$ file$ obj# ) 1119 get-mos-dnode ( path$ file$ ) 1120 1121 \ check for snapshot names 1122 ascii @ left-parse-string ( path$ snap$ file$ ) 1123 1124 \ search it 1125 dnode -rot zap-lookup if ( path$ snap$ ) 1126 \ not found 1127 2drop 2drop true exit ( not-found ) 1128 then ( path$ snap$ obj# ) 1129 get-mos-dnode ( path$ snap$ ) 1130 1131 \ lookup any snapshot name 1132 dup if 1133 \ must be last path component 1134 2swap nip if ( snap$ ) 1135 2drop true exit ( not-found ) 1136 then 1137 dnode dir>ds snap-look if ( ) 1138 true exit ( not-found ) 1139 then ( obj# ) 1140 false exit ( obj# found ) 1141 else 2drop then ( path$ ) 1142 1143 dnode >r ( path$ r: dn ) 1144 repeat ( path$ file$ r: dn) 1145 2drop 2drop r> drop ( ) 1146 1147 \ found it, return dataset obj# 1148 dnode dir>ds ( ds-obj# ) 1149 false ( ds-obj# found ) 1150 ; 1151 1152 \ get objset from dataset 1153 : get-objset ( adr dn -- ) 1154 >dsl-ds ds_bp dup bp-lsize swap read-bp 1155 ; 1156 1157 1158 \ 1159 \ ZFS file-system (ZPL) routines 1160 \ 1161 1162 1 constant master-node# 1163 1164 0 instance value bootfs-obj# 1165 0 instance value root-obj# 1166 0 instance value current-obj# 1167 0 instance value search-obj# 1168 1169 instance defer fsize ( dn -- size ) 1170 instance defer mode ( dn -- mode ) 1171 instance defer parent ( dn -- obj# ) 1172 instance defer readlink ( dst dn -- ) 1173 1174 \ 1175 \ routines when bonus pool contains a znode 1176 \ 1177 d# 264 constant /znode 1178 d# 56 constant /zn-slink 1179 1180 : zp_mode ( zn -- n ) h# 48 + x@ ; 1181 : zp_size ( zn -- n ) h# 50 + x@ ; 1182 : zp_parent ( zn -- n ) h# 58 + x@ ; 1183 1184 alias >znode dn_bonus 1185 1186 : zn-fsize ( dn -- n ) >znode zp_size ; 1187 : zn-mode ( dn -- n ) >znode zp_mode ; 1188 : zn-parent ( dn -- n ) >znode zp_parent ; 1189 1190 \ copy symlink target to dst 1191 : zn-readlink ( dst dn -- ) 1192 dup zn-fsize tuck /zn-slink > if ( dst size dn ) 1193 \ contents in 1st block 1194 temp-space over dn-bsize ( dst size dn t-adr bsize ) 1195 rot 0 lblk#>bp read-bp ( dst size ) 1196 temp-space ( dst size src ) 1197 else ( dst size dn ) 1198 \ contents in dnode 1199 >znode /znode + ( dst size src ) 1200 then ( dst size src ) 1201 -rot move ( ) 1202 ; 1203 1204 \ 1205 \ routines when bonus pool contains sa's 1206 \ 1207 1208 \ SA header size when link is in dn_bonus 1209 d# 16 constant /sahdr-link 1210 1211 : sa_props ( sa -- n ) h# 4 + w@ ; 1212 1213 : sa-hdrsz ( sa -- sz ) sa_props h# 7 >> ; 1214 1215 alias >sa dn_bonus 1216 1217 : >sadata ( dn -- adr ) >sa dup sa-hdrsz + ; 1218 : sa-mode ( dn -- n ) >sadata x@ ; 1219 : sa-fsize ( dn -- n ) >sadata h# 8 + x@ ; 1220 : sa-parent ( dn -- n ) >sadata h# 28 + x@ ; 1221 1222 \ copy symlink target to dst 1223 : sa-readlink ( dst dn -- ) 1224 dup >sa sa-hdrsz /sahdr-link <> if 1225 \ contents in 1st attr of dn_spill 1226 temp-space over dn_spill ( dst dn t-adr bp ) 1227 dup bp-lsize swap read-bp ( dst dn ) 1228 sa-fsize ( dst size ) 1229 temp-space dup sa-hdrsz + ( dst size src ) 1230 else ( dst dn ) 1231 \ content in bonus buf 1232 dup dn_bonus over dn_bonuslen + ( dst dn ebonus ) 1233 swap sa-fsize tuck - ( dst size src ) 1234 then ( dst size src ) 1235 -rot move ( ) 1236 ; 1237 1238 1239 \ setup attr routines for dn 1240 : set-attr ( dn -- ) 1241 dn_bonustype ot-sa# = if 1242 ['] sa-fsize to fsize 1243 ['] sa-mode to mode 1244 ['] sa-parent to parent 1245 ['] sa-readlink to readlink 1246 else 1247 ['] zn-fsize to fsize 1248 ['] zn-mode to mode 1249 ['] zn-parent to parent 1250 ['] zn-readlink to readlink 1251 then 1252 ; 1253 1254 : ftype ( dn -- type ) mode h# f000 and ; 1255 : dir? ( dn -- flag ) ftype h# 4000 = ; 1256 : symlink? ( dn -- flag ) ftype h# a000 = ; 1257 1258 \ read obj# from fs objset 1259 : get-fs-dnode ( obj# -- ) 1260 dup to current-obj# 1261 fs-dn swap get-dnode ( ) 1262 ; 1263 1264 \ get root-obj# from dataset 1265 : get-rootobj# ( ds-obj# -- fsroot-obj# ) 1266 dup to bootfs-obj# 1267 get-mos-dnode ( ) 1268 fs-dn dnode get-objset 1269 1270 \ get root obj# from master node 1271 master-node# get-fs-dnode 1272 dnode " ROOT" zap-lookup if 1273 " no ROOT" die 1274 then ( fsroot-obj# ) 1275 ; 1276 1277 : prop>rootobj# ( -- ) 1278 obj-dir " pool_props" zap-lookup if 1279 " no pool_props" die 1280 then ( prop-obj# ) 1281 get-mos-dnode ( ) 1282 dnode " bootfs" zap-lookup if 1283 " no bootfs" die 1284 then ( ds-obj# ) 1285 get-rootobj# ( fsroot-obj# ) 1286 ; 1287 1288 : fs>rootobj# ( fs$ -- root-obj# not-found? ) 1289 1290 \ skip pool name 1291 ascii / left-parse-string 2drop 1292 1293 \ lookup fs in dsl 1294 dsl-lookup if ( ) 1295 true exit ( not-found ) 1296 then ( ds-obj# ) 1297 1298 get-rootobj# ( fsroot-obj# ) 1299 false ( fsroot-obj# found ) 1300 ; 1301 1302 \ lookup file is current directory 1303 : dirlook ( file$ dn -- not-found? ) 1304 \ . and .. are magic 1305 -rot 2dup " ." $= if ( dn file$ ) 1306 3drop false exit ( found ) 1307 then 1308 1309 2dup " .." $= if 1310 2drop parent ( obj# ) 1311 else ( dn file$ ) 1312 \ search dir 1313 current-obj# to search-obj# 1314 zap-lookup if ( ) 1315 true exit ( not-found ) 1316 then ( obj# ) 1317 then ( obj# ) 1318 get-fs-dnode 1319 dnode set-attr 1320 false ( found ) 1321 ; 1322 1323 /buf-len instance buffer: fpath-buf 1324 /buf-len instance buffer: tpath-buf 1325 1326 : tpath-buf$ ( -- path$ ) tpath-buf cscount ; 1327 : fpath-buf$ ( -- path$ ) fpath-buf cscount ; 1328 1329 \ modify tail to account for symlink 1330 : follow-symlink ( tail$ -- tail$' ) 1331 \ read target 1332 tpath-buf /buf-len erase 1333 tpath-buf dnode readlink 1334 1335 \ append current path 1336 ?dup if ( tail$ ) 1337 " /" tpath-buf$ $append ( tail$ ) 1338 tpath-buf$ $append ( ) 1339 else drop then ( ) 1340 1341 \ copy to fpath 1342 fpath-buf /buf-len erase 1343 tpath-buf$ fpath-buf swap move 1344 fpath-buf$ ( path$ ) 1345 1346 \ get directory that starts changed path 1347 over c@ ascii / = if ( path$ ) 1348 str++ root-obj# ( path$' obj# ) 1349 else ( path$ ) 1350 search-obj# ( path$ obj# ) 1351 then ( path$ obj# ) 1352 get-fs-dnode ( path$ ) 1353 dnode set-attr 1354 ; 1355 1356 \ open dnode at path 1357 : lookup ( path$ -- not-found? ) 1358 1359 \ get directory that starts path 1360 over c@ ascii / = if 1361 str++ root-obj# ( path$' obj# ) 1362 else 1363 current-obj# ( path$ obj# ) 1364 then ( path$ obj# ) 1365 get-fs-dnode ( path$ ) 1366 dnode set-attr 1367 1368 \ lookup each path component 1369 begin ( path$ ) 1370 ascii / left-parse-string ( path$ file$ ) 1371 dup while 1372 dnode dir? 0= if 1373 2drop true exit ( not-found ) 1374 then ( path$ file$ ) 1375 dnode dirlook if ( path$ ) 1376 2drop true exit ( not-found ) 1377 then ( path$ ) 1378 dnode symlink? if 1379 follow-symlink ( path$' ) 1380 then ( path$ ) 1381 repeat ( path$ file$ ) 1382 2drop 2drop false ( found ) 1383 ; 1384 1385 \ 1386 \ ZFS volume (ZVOL) routines 1387 \ 1388 1 constant zvol-data# 1389 2 constant zvol-prop# 1390 1391 0 instance value zv-dn 1392 1393 : get-zvol ( zvol$ -- not-found? ) 1394 dsl-lookup if 1395 drop true exit ( failed ) 1396 then ( ds-obj# ) 1397 1398 \ get zvol objset 1399 get-mos-dnode ( ) 1400 zv-dn dnode get-objset 1401 false ( succeeded ) 1402 ; 1403 1404 \ get zvol data dnode 1405 : zvol-data ( -- ) 1406 zv-dn zvol-data# get-dnode 1407 ; 1408 1409 : zvol-size ( -- size ) 1410 zv-dn zvol-prop# get-dnode 1411 dnode " size" zap-lookup if 1412 " no zvol size" die 1413 then ( size ) 1414 ; 1415 1416 1417 \ 1418 \ ZFS installation routines 1419 \ 1420 1421 \ ZFS file interface 1422 struct 1423 /x field >busy 1424 /x field >offset 1425 /x field >fsize 1426 /dnode field >dnode 1427 constant /file-record 1428 1429 d# 10 constant #opens 1430 #opens /file-record * constant /file-records 1431 1432 /file-records instance buffer: file-records 1433 1434 -1 instance value current-fd 1435 1436 : fd>record ( fd -- rec ) /file-record * file-records + ; 1437 : file-offset@ ( -- off ) current-fd fd>record >offset x@ ; 1438 : file-offset! ( off -- ) current-fd fd>record >offset x! ; 1439 : file-dnode ( -- dn ) current-fd fd>record >dnode ; 1440 : file-size ( -- size ) current-fd fd>record >fsize x@ ; 1441 : file-bsize ( -- bsize ) file-dnode dn-bsize ; 1442 1443 \ find free fd slot 1444 : get-slot ( -- fd false | true ) 1445 #opens 0 do 1446 i fd>record >busy x@ 0= if 1447 i false unloop exit 1448 then 1449 loop true 1450 ; 1451 1452 : free-slot ( fd -- ) 1453 0 swap fd>record >busy x! 1454 ; 1455 1456 \ init fd to offset 0 and copy dnode 1457 : init-fd ( fsize fd -- ) 1458 fd>record ( fsize rec ) 1459 dup >busy 1 swap x! 1460 dup >dnode dnode swap /dnode move 1461 dup >fsize rot swap x! ( rec ) 1462 >offset 0 swap x! ( ) 1463 ; 1464 1465 \ make fd current 1466 : set-fd ( fd -- error? ) 1467 dup fd>record >busy x@ 0= if ( fd ) 1468 drop true exit ( failed ) 1469 then ( fd ) 1470 to current-fd false ( succeeded ) 1471 ; 1472 1473 \ read next fs block 1474 : file-bread ( adr -- ) 1475 file-bsize ( adr len ) 1476 file-offset@ over / ( adr len blk# ) 1477 file-dnode swap lblk#>bp ( adr len bp ) 1478 read-bp ( ) 1479 ; 1480 1481 \ advance file io stack by n 1482 : fio+ ( # adr len n -- #+n adr+n len-n ) 1483 dup file-offset@ + file-offset! 1484 dup >r - -rot ( len' # adr r: n ) 1485 r@ + -rot ( adr' len' # r: n ) 1486 r> + -rot ( #' adr' len' ) 1487 ; 1488 1489 1490 /max-bsize 5 * 1491 /uber-block + 1492 /dnode 6 * + 1493 /disk-block 6 * + ( size ) 1494 \ ugh - sg proms can't free 512k allocations 1495 \ that aren't a multiple of 512k in size 1496 h# 8.0000 roundup ( size' ) 1497 constant alloc-size 1498 1499 1500 : allocate-buffers ( -- ) 1501 alloc-size h# a0.0000 vmem-alloc dup 0= if 1502 " no memory" die 1503 then ( adr ) 1504 dup to temp-space /max-bsize + ( adr ) 1505 dup to dn-cache /max-bsize + ( adr ) 1506 dup to blk-space /max-bsize + ( adr ) 1507 dup to ind-cache /max-bsize + ( adr ) 1508 dup to zap-space /max-bsize + ( adr ) 1509 dup to uber-block /uber-block + ( adr ) 1510 dup to mos-dn /dnode + ( adr ) 1511 dup to obj-dir /dnode + ( adr ) 1512 dup to root-dsl /dnode + ( adr ) 1513 dup to fs-dn /dnode + ( adr ) 1514 dup to zv-dn /dnode + ( adr ) 1515 dup to dnode /dnode + ( adr ) 1516 to gang-space ( ) 1517 1518 \ zero instance buffers 1519 file-records /file-records erase 1520 bootprop-buf /buf-len erase 1521 ; 1522 1523 : release-buffers ( -- ) 1524 temp-space alloc-size mem-free 1525 ; 1526 1527 external 1528 1529 : open ( -- okay? ) 1530 my-args dev-open dup 0= if 1531 exit ( failed ) 1532 then to dev-ih 1533 1534 allocate-buffers 1535 scan-vdev 1536 get-ub 1537 get-root-dsl 1538 true 1539 ; 1540 1541 : open-fs ( fs$ -- okay? ) 1542 fs>rootobj# if ( ) 1543 false ( failed ) 1544 else ( obj# ) 1545 to root-obj# true ( succeeded ) 1546 then ( okay? ) 1547 ; 1548 1549 : close ( -- ) 1550 dev-ih dev-close 1551 0 to dev-ih 1552 release-buffers 1553 ; 1554 1555 : open-file ( path$ -- fd true | false ) 1556 1557 \ open default fs if no open-fs 1558 root-obj# 0= if 1559 prop>rootobj# to root-obj# 1560 then 1561 1562 get-slot if 1563 2drop false exit ( failed ) 1564 then -rot ( fd path$ ) 1565 1566 lookup if ( fd ) 1567 drop false exit ( failed ) 1568 then ( fd ) 1569 1570 dnode fsize over init-fd 1571 true ( fd succeeded ) 1572 ; 1573 1574 : open-volume ( vol$ -- okay? ) 1575 get-slot if 1576 2drop false exit ( failed ) 1577 then -rot ( fd vol$ ) 1578 1579 get-zvol if ( fd ) 1580 drop false exit ( failed ) 1581 then 1582 1583 zvol-size over ( fd size fd ) 1584 zvol-data init-fd ( fd ) 1585 true ( fd succeeded ) 1586 ; 1587 1588 : close-file ( fd -- ) 1589 free-slot ( ) 1590 ; 1591 1592 : size-file ( fd -- size ) 1593 set-fd if 0 else file-size then 1594 ; 1595 1596 : seek-file ( off fd -- off true | false ) 1597 set-fd if ( off ) 1598 drop false exit ( failed ) 1599 then ( off ) 1600 1601 dup file-size x> if ( off ) 1602 drop false exit ( failed ) 1603 then ( off ) 1604 dup file-offset! true ( off succeeded ) 1605 ; 1606 1607 : read-file ( adr len fd -- #read ) 1608 set-fd if ( adr len ) 1609 2drop 0 exit ( 0 ) 1610 then ( adr len ) 1611 1612 \ adjust len if reading past eof 1613 dup file-offset@ + file-size x> if 1614 dup file-offset@ + file-size - - 1615 then 1616 dup 0= if nip exit then 1617 1618 0 -rot ( #read adr len ) 1619 1620 \ initial partial block 1621 file-offset@ file-bsize mod ?dup if ( #read adr len off ) 1622 temp-space file-bread 1623 2dup file-bsize swap - min ( #read adr len off cpy-len ) 1624 2over drop -rot ( #read adr len adr off cpy-len ) 1625 >r temp-space + swap ( #read adr len cpy-src adr r: cpy-len ) 1626 r@ move r> fio+ ( #read' adr' len' ) 1627 then ( #read adr len ) 1628 1629 dup file-bsize / 0 ?do ( #read adr len ) 1630 over file-bread 1631 file-bsize fio+ ( #read' adr' len' ) 1632 loop ( #read adr len ) 1633 1634 \ final partial block 1635 dup if ( #read adr len ) 1636 temp-space file-bread 1637 2dup temp-space -rot move ( #read adr len ) 1638 dup fio+ ( #read' adr' 0 ) 1639 then 2drop ( #read ) 1640 ; 1641 1642 : cinfo-file ( fd -- bsize fsize comp? ) 1643 set-fd if 1644 0 0 0 1645 else 1646 file-bsize file-size ( bsize fsize ) 1647 \ zfs does internal compression 1648 0 ( bsize fsize comp? ) 1649 then 1650 ; 1651 1652 \ read ramdisk fcode at rd-offset 1653 : get-rd ( adr len -- ) 1654 rd-offset dev-ih read-disk 1655 ; 1656 1657 : bootprop 1658 " /" bootprop$ $append 1659 bootfs-obj# (xu.) bootprop$ $append 1660 bootprop$ encode-string " zfs-bootfs" ( propval propname ) 1661 true 1662 ; 1663 1664 1665 : chdir ( dir$ -- ) 1666 current-obj# -rot ( obj# dir$ ) 1667 lookup if ( obj# ) 1668 to current-obj# ( ) 1669 ." no such dir" cr exit 1670 then ( obj# ) 1671 dnode dir? 0= if ( obj# ) 1672 to current-obj# ( ) 1673 ." not a dir" cr exit 1674 then drop ( ) 1675 ; 1676 1677 : dir ( -- ) 1678 current-obj# get-fs-dnode 1679 dnode zap-print 1680 ; 1681 1682finish-device 1683pop-package 1684