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_etype ( bp -- n ) h# 32 + c@ ; 440 : blk_comp ( bp -- n ) h# 33 + c@ h# 7f and ; 441 : blk_embedded? ( bp -- flag ) h# 33 + c@ h# 80 and h# 80 = ; 442 : blk_psize ( bp -- n ) h# 34 + w@ ; 443 : blk_lsize ( bp -- n ) h# 36 + w@ ; 444 : blk_birth ( bp -- n ) h# 50 + x@ ; 445 446 : blke_psize ( bp -- n ) h# 34 + c@ 1 rshift h# 7f and 1+ ; 447 : blke_lsize ( bp -- n ) h# 34 + l@ h# 1ff.ffff and 1+ ; 448 449 0 instance value dev-ih 450 0 instance value blk-space 451 0 instance value gang-space 452 453 : foff>doff ( fs-off -- disk-off ) /disk-block * h# 40.0000 + ; 454 : fsz>dsz ( fs-size -- disk-size ) 1+ /disk-block * ; 455 456 : bp-dsize ( bp -- dsize ) 457 dup blk_embedded? if 458 blke_psize 459 else 460 blk_psize fsz>dsz 461 then 462 ; 463 464 : bp-lsize ( bp -- lsize ) 465 dup blk_embedded? if 466 blke_lsize 467 else 468 blk_lsize fsz>dsz 469 then 470 ; 471 472 : (read-dva) ( adr len dva -- ) 473 blk_offset foff>doff dev-ih read-disk 474 ; 475 476 : gang-read ( adr len bp gb-adr -- ) tokenizer[ reveal ]tokenizer 477 478 \ read gang block 479 tuck /gang-block rot (read-dva) ( adr len gb-adr ) 480 481 \ loop through indirected bp's 482 dup /blkp #blks/gang * ( adr len gb-adr bp-list bp-list-len ) 483 bounds do ( adr len gb-adr ) 484 i blk_offset x0= ?leave 485 486 \ calc subordinate read len 487 over i bp-dsize min ( adr len gb-adr sub-len ) 488 2swap swap ( gb-adr sub-len len adr ) 489 490 \ nested gang block - recurse with new gang block area 491 i blk_gang if 492 2swap ( len adr gb-adr sub-len ) 493 3dup swap /gang-block + ( len adr gb-adr sub-len adr sub-len gb-adr' ) 494 i swap gang-read ( len adr gb-adr sub-len ) 495 2swap ( gb-adr sub-len len adr ) 496 else 497 3dup nip swap ( gb-adr sub-len len adr adr sub-len ) 498 i (read-dva) ( gb-adr sub-len len adr ) 499 then ( gb-adr sub-len len adr ) 500 501 \ adjust adr,len and check if done 502 -rot over - ( gb-adr adr sub-len len' ) 503 -rot + swap ( gb-adr adr' len' ) 504 dup 0= ?leave 505 rot ( adr' len' gb-adr ) 506 /blkp +loop 507 3drop ( ) 508 ; 509 510 : read-dva ( adr len dva -- ) 511 dup blk_gang if 512 gang-space gang-read 513 else 514 (read-dva) 515 then 516 ; 517 518 : read-embedded ( adr len bp -- ) 519 \ loop over buf len, w in comment is octet count 520 \ note, we dont increment bp, but use index value of w 521 \ so we can skip the non-payload octets 522 swap 0 0 ( adr bp len 0 0 ) 523 rot 0 do ( adr bp 0 0 ) 524 I 8 mod 0= if ( adr bp w x ) 525 drop ( adr bp w ) 526 2dup ( adr bp w bp w ) 527 xa+ ( adr bp w bp+w*8 ) 528 x@ swap ( adr bp x w ) 529 1+ dup 6 = if 1+ else \ skip 6th word 530 dup h# a = if 1+ then \ skip 10th word 531 then ( adr bp x w ) 532 swap ( adr bp w x ) 533 then 534 2swap ( w x adr bp ) 535 -rot ( w bp x adr ) 536 swap dup ( w bp adr x x ) 537 I 8 mod 4 < if 538 xlsplit ( w bp adr x x.lo x.hi ) 539 drop ( w bp adr x x.lo ) 540 else 541 xlsplit ( w bp adr x x.lo x.hi ) 542 nip ( w bp adr x x.hi ) 543 then 544 I 4 mod 8 * rshift h# ff and ( w bp adr x c ) 545 rot ( w bp x c adr ) 546 swap over ( w bp x adr c adr ) 547 I + c! ( w bp x adr ) 548 549 \ now we need to fix the stack for next pass 550 \ need to get ( adr bp w x ) 551 swap 2swap ( adr x w bp ) 552 -rot ( adr bp x w ) 553 swap ( adr bp w x ) 554 loop 555 2drop 2drop 556 ; 557 558 \ block read that check for holes, gangs, compression, etc 559 : read-bp ( adr len bp -- ) 560 \ sparse block? 561 dup x@ x0= ( addr len bp flag0 ) 562 swap dup 8 + x@ x0= ( addr len flag0 bp flag1 ) 563 rot ( addr len bp flag1 flag0 ) 564 and if 565 drop erase exit ( ) 566 then 567 568 \ no compression? 569 dup blk_comp no-comp# = if 570 read-dva exit ( ) 571 then 572 573 \ read into blk-space. read is either from embedded area or disk 574 dup blk_embedded? if 575 dup blk-space over bp-dsize ( adr len bp bp blk-adr rd-len ) 576 rot read-embedded ( adr len bp ) 577 else 578 dup blk-space over bp-dsize ( adr len bp bp blk-adr rd-len ) 579 rot read-dva ( adr len bp ) 580 then 581 582 \ set up the stack for decompress 583 blk_comp >r ( adr len R: alg ) 584 blk-space -rot r> ( blk-adr adr len alg ) 585 586 case 587 lzjb-comp# of lzjb endof 588 lz4-comp# of lz4 endof 589 def-comp# of lz4 endof \ isn't this writer only? 590 dup .h 591 " : unknown compression algorithm, only lzjb and lz4 are supported" 592 die 593 endcase ( ) 594 ; 595 596 \ 597 \ ZFS vdev routines 598 \ 599 600 h# 1.c000 constant /nvpairs 601 h# 4000 constant nvpairs-off 602 603 \ 604 \ xdr packed nvlist 605 \ 606 \ 12B header 607 \ array of xdr packed nvpairs 608 \ 4B encoded nvpair size 609 \ 4B decoded nvpair size 610 \ 4B name string size 611 \ name string 612 \ 4B data type 613 \ 4B # of data elements 614 \ data 615 \ 8B of 0 616 \ 617 d# 12 constant /nvhead 618 619 : >nvsize ( nv -- size ) l@ ; 620 : >nvname ( nv -- name$ ) 621 /l 2* + dup /l + swap l@ 622 ; 623 : >nvdata ( nv -- data ) 624 >nvname + /l roundup 625 ; 626 627 \ convert nvdata to 64b int or string 628 : nvdata>x ( nvdata -- x ) 629 /l 2* + ( ptr ) 630 dup /l + l@ swap l@ ( x.lo x.hi ) 631 lxjoin ( x ) 632 ; 633 alias nvdata>$ >nvname 634 635 : nv-lookup ( nv name$ -- nvdata false | true ) 636 rot /nvhead + ( name$ nvpair ) 637 begin dup >nvsize while 638 dup >r >nvname ( name$ nvname$ r: nvpair ) 639 2over $= if ( name$ r: nvpair ) 640 2drop r> >nvdata ( nvdata ) 641 false exit ( nvdata found ) 642 then ( name$ r: nvpair ) 643 r> dup >nvsize + ( name$ nvpair' ) 644 repeat 645 3drop true ( not-found ) 646 ; 647 648 : scan-vdev ( -- ) 649 temp-space /nvpairs nvpairs-off ( adr len off ) 650 dev-ih read-disk ( ) 651 temp-space " txg" nv-lookup if 652 " no txg nvpair" die 653 then nvdata>x ( txg ) 654 x0= if 655 " detached mirror" die 656 then ( ) 657 temp-space " name" nv-lookup if 658 " no name nvpair" die 659 then nvdata>$ ( pool$ ) 660 bootprop-buf swap move ( ) 661 ; 662 663 664 \ 665 \ ZFS ueber-block routines 666 \ 667 668 d# 1024 constant /uber-block 669 d# 128 constant #ub/label 670 #ub/label /uber-block * constant /ub-ring 671 h# 2.0000 constant ubring-off 672 673 : ub_magic ( ub -- n ) x@ ; 674 : ub_txg ( ub -- n ) h# 10 + x@ ; 675 : ub_timestamp ( ub -- n ) h# 20 + x@ ; 676 : ub_rootbp ( ub -- p ) h# 28 + ; 677 678 0 instance value uber-block 679 680 : ub-cmp ( ub1 ub2 -- best-ub ) 681 682 \ ub1 wins if ub2 isn't valid 683 dup ub_magic h# 00bab10c x<> if 684 drop exit ( ub1 ) 685 then 686 687 \ if ub1 is 0, ub2 wins by default 688 over 0= if nip exit then ( ub2 ) 689 690 \ 2 valid ubs, compare transaction groups 691 over ub_txg over ub_txg ( ub1 ub2 txg1 txg2 ) 692 2dup x< if 693 2drop nip exit ( ub2 ) 694 then ( ub1 ub2 txg1 txg2 ) 695 x> if drop exit then ( ub1 ) 696 697 \ same txg, check timestamps 698 over ub_timestamp over ub_timestamp x> if 699 nip ( ub2 ) 700 else 701 drop ( ub1 ) 702 then 703 ; 704 705 \ find best uber-block in ring, and copy it to uber-block 706 : get-ub ( -- ) 707 temp-space /ub-ring ubring-off ( adr len off ) 708 dev-ih read-disk ( ) 709 0 temp-space /ub-ring ( null-ub adr len ) 710 bounds do ( ub ) 711 i ub-cmp ( best-ub ) 712 /uber-block +loop 713 714 \ make sure we found a valid ub 715 dup 0= if " no ub found" die then 716 717 uber-block /uber-block move ( ) 718 ; 719 720 721 \ 722 \ ZFS dnode (DMU) routines 723 \ 724 725 d# 44 constant ot-sa# 726 727 d# 512 constant /dnode 728 729 : dn_indblkshift ( dn -- n ) h# 1 + c@ ; 730 : dn_nlevels ( dn -- n ) h# 2 + c@ ; 731 : dn_bonustype ( dn -- n ) h# 4 + c@ ; 732 : dn_datablkszsec ( dn -- n ) h# 8 + w@ ; 733 : dn_bonuslen ( dn -- n ) h# a + w@ ; 734 : dn_blkptr ( dn -- p ) h# 40 + ; 735 : dn_bonus ( dn -- p ) h# c0 + ; 736 : dn_spill ( dn -- p ) h# 180 + ; 737 738 0 instance value dnode 739 740 \ indirect cache 741 \ 742 \ ind-cache is a 1 block indirect block cache from dnode ic-dn 743 \ 744 \ ic-bp and ic-bplim point into the ic-dn's block ptr array, 745 \ either in dn_blkptr or in ind-cache ic-bp is the ic-blk#'th 746 \ block ptr, and ic-bplim is limit of the current bp array 747 \ 748 \ the assumption is that reads will be sequential, so we can 749 \ just increment ic-bp 750 \ 751 0 instance value ind-cache 752 0 instance value ic-dn 753 0 instance value ic-blk# 754 0 instance value ic-bp 755 0 instance value ic-bplim 756 757 : dn-bsize ( dn -- bsize ) dn_datablkszsec /disk-block * ; 758 : dn-indsize ( dn -- indsize ) dn_indblkshift pow2 ; 759 : dn-indmask ( dn -- mask ) dn-indsize 1- ; 760 761 \ recursively climb the block tree from the leaf to the root 762 : blk@lvl>bp ( dn blk# lvl -- bp ) tokenizer[ reveal ]tokenizer 763 >r /blkp * over dn_nlevels ( dn bp-off #lvls r: lvl ) 764 765 \ at top, just add dn_blkptr 766 r@ = if ( dn bp-off r: lvl ) 767 swap dn_blkptr + ( bp r: lvl ) 768 r> drop exit ( bp ) 769 then ( dn bp-off r: lvl ) 770 771 \ shift bp-off down and find parent indir blk 772 2dup over dn_indblkshift rshift ( dn bp-off dn blk# r: lvl ) 773 r> 1+ blk@lvl>bp ( dn bp-off bp ) 774 775 \ read parent indir blk and index 776 rot tuck dn-indsize ( bp-off dn bp len ) 777 ind-cache swap rot read-bp ( bp-off dn ) 778 dn-indmask and ( bp-off' ) 779 ind-cache + ( bp ) 780 ; 781 782 \ return end of current bp array 783 : bplim ( dn bp -- bp-lim ) 784 over dn_nlevels 1 = if 785 drop dn_blkptr ( bp0 ) 786 3 /blkp * + ( bplim ) 787 else 788 1+ swap dn-indsize ( bp+1 indsz ) 789 roundup ( bplim ) 790 then 791 ; 792 793 \ return the lblk#'th block ptr from dnode 794 : lblk#>bp ( dn blk# -- bp ) 795 2dup ( dn blk# dn blk# ) 796 ic-blk# <> swap ic-dn <> or ( dn blk# cache-miss? ) 797 ic-bp ic-bplim = ( dn blk# cache-miss? cache-empty? ) 798 or if ( dn blk# ) 799 2dup 1 blk@lvl>bp ( dn blk# bp ) 800 dup to ic-bp ( dn blk# bp ) 801 swap to ic-blk# ( dn bp ) 802 2dup bplim to ic-bplim ( dn bp ) 803 over to ic-dn 804 then 2drop ( ) 805 ic-blk# 1+ to ic-blk# 806 ic-bp dup /blkp + to ic-bp ( bp ) 807 ; 808 809 810 \ 811 \ ZFS attribute (ZAP) routines 812 \ 813 814 1 constant fzap# 815 3 constant uzap# 816 817 d# 64 constant /uzap 818 819 d# 24 constant /lf-chunk 820 d# 21 constant /lf-arr 821 h# ffff constant chain-end# 822 823 h# 100 constant /lf-buf 824 /lf-buf instance buffer: leaf-value 825 /lf-buf instance buffer: leaf-name 826 827 : +le ( len off -- n ) + w@ ; 828 : le_next ( le -- n ) h# 2 +le ; 829 : le_name_chunk ( le -- n ) h# 4 +le ; 830 : le_name_length ( le -- n ) h# 6 +le ; 831 : le_value_chunk ( le -- n ) h# 8 +le ; 832 : le_value_length ( le -- n ) h# a +le ; 833 834 : la_array ( la -- adr ) 1+ ; 835 : la_next ( la -- n ) h# 16 + w@ ; 836 837 0 instance value zap-space 838 839 \ setup leaf hash bounds 840 : >leaf-hash ( dn lh -- hash-adr /hash ) 841 /lf-chunk 2* + ( dn hash-adr ) 842 \ size = (bsize / 32) * 2 843 swap dn-bsize 4 rshift ( hash-adr /hash ) 844 ; 845 : >leaf-chunks ( lf -- ch0 ) >leaf-hash + ; 846 847 \ convert chunk # to leaf chunk 848 : ch#>lc ( dn ch# -- lc ) 849 /lf-chunk * ( dn lc-off ) 850 swap zap-space >leaf-chunks ( lc-off ch0 ) 851 + ( lc ) 852 ; 853 854 \ assemble chunk chain into single buffer 855 : get-chunk-data ( dn ch# adr -- ) 856 dup >r /lf-buf erase ( dn ch# r: adr ) 857 begin 858 2dup ch#>lc nip ( dn la r: adr ) 859 dup la_array ( dn la la-arr r: adr ) 860 r@ /lf-arr move ( dn la r: adr ) 861 r> /lf-arr + >r ( dn la r: adr' ) 862 la_next dup chain-end# = ( dn la-ch# end? r: adr ) 863 until r> 3drop ( ) 864 ; 865 866 \ get leaf entry's name 867 : entry-name$ ( dn le -- name$ ) 868 2dup le_name_chunk ( dn le dn la-ch# ) 869 leaf-name get-chunk-data ( dn le ) 870 nip le_name_length 1- ( len ) 871 leaf-name swap ( name$ ) 872 ; 873 874 \ return entry value as int 875 : entry-int-val ( dn le -- n ) 876 le_value_chunk ( dn la-ch# ) 877 leaf-value get-chunk-data ( ) 878 leaf-value x@ ( n ) 879 ; 880 881 882[ifdef] strlookup 883 \ get leaf entry's value as string 884 : entry-val$ ( dn le -- val$ ) 885 2dup le_value_chunk ( dn le dn la-ch# ) 886 leaf-value get-chunk-data ( dn le ) 887 nip le_value_length ( len ) 888 leaf-value swap ( name$ ) 889 ; 890[then] 891 892 \ apply xt to entry 893 : entry-apply ( xt dn le -- xt dn false | ??? true ) 894 over >r ( xt dn le r: dn ) 895 rot dup >r execute if ( ??? r: xt dn ) 896 r> r> 2drop true ( ??? true ) 897 else ( ) 898 r> r> false ( xt dn false ) 899 then 900 ; 901 902 \ apply xt to every entry in chain 903 : chain-apply ( xt dn ch# -- xt dn false | ??? true ) 904 begin 905 2dup ch#>lc nip ( xt dn le ) 906 dup >r entry-apply if ( ??? r: le ) 907 r> drop true exit ( ??? found ) 908 then ( xt dn r: le ) 909 r> le_next ( xt dn ch# ) 910 dup chain-end# = ( xt dn ch# end? ) 911 until drop ( xt dn ) 912 false ( xt dn false ) 913 ; 914 915 \ apply xt to every entry in leaf 916 : leaf-apply ( xt dn blk# -- xt dn false | ??? true ) 917 918 \ read zap leaf into zap-space 919 2dup lblk#>bp ( xt dn blk# bp ) 920 nip over dn-bsize zap-space ( xt dn bp len adr ) 921 swap rot read-bp ( xt dn ) 922 923 \ call chunk-look for every valid chunk list 924 dup zap-space >leaf-hash ( xt dn hash-adr /hash ) 925 bounds do ( xt dn ) 926 i w@ dup chain-end# <> if ( xt dn ch# ) 927 chain-apply if ( ??? ) 928 unloop true exit ( ??? found ) 929 then ( xt dn ) 930 else drop then ( xt dn ) 931 /w +loop 932 false ( xt dn not-found ) 933 ; 934 935 \ apply xt to every entry in fzap 936 : fzap-apply ( xt dn fz -- ??? not-found? ) 937 938 \ blk# 1 is always the 1st leaf 939 >r 1 leaf-apply if ( ??? r: fz ) 940 r> drop true exit ( ??? found ) 941 then r> ( xt dn fz ) 942 943 \ call leaf-apply on every non-duplicate hash entry 944 \ embedded hash is in 2nd half of fzap block 945 over dn-bsize tuck + ( xt dn bsize hash-eadr ) 946 swap 2dup 2/ - ( xt dn hash-eadr bsize hash-adr ) 947 nip do ( xt dn ) 948 i x@ dup 1 <> if ( xt dn blk# ) 949 leaf-apply if ( ??? ) 950 unloop true exit ( ??? found ) 951 then ( xt dn ) 952 else drop then ( xt dn ) 953 /x +loop 954 2drop false ( not-found ) 955 ; 956 957 : mze_value ( uz -- n ) x@ ; 958 : mze_name ( uz -- p ) h# e + ; 959 960 : uzap-name$ ( uz -- name$ ) mze_name cscount ; 961 962 \ apply xt to each entry in micro-zap 963 : uzap-apply ( xt uz len -- ??? not-found? ) 964 bounds do ( xt ) 965 i swap dup >r ( uz xt r: xt ) 966 execute if ( ??? r: xt ) 967 r> drop ( ??? ) 968 unloop true exit ( ??? found ) 969 then r> ( xt ) 970 /uzap +loop 971 drop false ( not-found ) 972 ; 973 974 \ match by name 975 : fz-nmlook ( prop$ dn le -- prop$ false | prop$ dn le true ) 976 2dup entry-name$ ( prop$ dn le name$ ) 977 2rot 2swap ( dn le prop$ name$ ) 978 2over $= if ( dn le prop$ ) 979 2swap true ( prop$ dn le true ) 980 else ( dn le prop$ ) 981 2swap 2drop false ( prop$ false ) 982 then ( prop$ false | prop$ dn le true ) 983 ; 984 985 \ match by name 986 : uz-nmlook ( prop$ uz -- prop$ false | prop$ uz true ) 987 dup >r uzap-name$ ( prop$ name$ r: uz ) 988 2over $= if ( prop$ r: uz ) 989 r> true ( prop$ uz true ) 990 else ( prop$ r: uz ) 991 r> drop false ( prop$ false ) 992 then ( prop$ false | prop$ uz true ) 993 ; 994 995 : zap-type ( zp -- n ) h# 7 + c@ ; 996 : >uzap-ent ( adr -- ent ) h# 40 + ; 997 998 \ read zap block into temp-space 999 : get-zap ( dn -- zp ) 1000 dup 0 lblk#>bp ( dn bp ) 1001 swap dn-bsize ( bp len ) 1002 temp-space swap ( bp adr len ) 1003 rot read-bp ( ) 1004 temp-space ( zp ) 1005 ; 1006 1007 \ find prop in zap dnode 1008 : zap-lookup ( dn prop$ -- [ n ] not-found? ) 1009 rot dup get-zap ( prop$ dn zp ) 1010 dup zap-type case 1011 uzap# of 1012 >uzap-ent swap dn-bsize ( prop$ uz len ) 1013 ['] uz-nmlook -rot ( prop$ xt uz len ) 1014 uzap-apply if ( prop$ uz ) 1015 mze_value -rot 2drop ( n ) 1016 false ( n found ) 1017 else ( prop$ ) 1018 2drop true ( !found ) 1019 then ( [ n ] not-found? ) 1020 endof 1021 fzap# of 1022 ['] fz-nmlook -rot ( prop$ xt dn fz ) 1023 fzap-apply if ( prop$ dn le ) 1024 entry-int-val ( prop$ n ) 1025 -rot 2drop false ( n found ) 1026 else ( prop$ ) 1027 2drop true ( !found ) 1028 then ( [ n ] not-found? ) 1029 endof 1030 3drop 2drop true ( !found ) 1031 endcase ( [ n ] not-found? ) 1032 ; 1033 1034[ifdef] strlookup 1035 : zap-lookup-str ( dn prop$ -- [ val$ ] not-found? ) 1036 rot dup get-zap ( prop$ dn zp ) 1037 dup zap-type fzap# <> if ( prop$ dn zp ) 1038 2drop 2drop true exit ( !found ) 1039 then ( prop$ dn zp ) 1040 ['] fz-nmlook -rot ( prop$ xt dn fz ) 1041 fzap-apply if ( prop$ dn le ) 1042 entry-val$ 2swap 2drop false ( val$ found ) 1043 else ( prop$ ) 1044 2drop true ( !found ) 1045 then ( [ val$ ] not-found? ) 1046 ; 1047[then] 1048 1049 : fz-print ( dn le -- false ) 1050 entry-name$ type cr false 1051 ; 1052 1053 : uz-print ( uz -- false ) 1054 uzap-name$ type cr false 1055 ; 1056 1057 : zap-print ( dn -- ) 1058 dup get-zap ( dn zp ) 1059 dup zap-type case 1060 uzap# of 1061 >uzap-ent swap dn-bsize ( uz len ) 1062 ['] uz-print -rot ( xt uz len ) 1063 uzap-apply ( false ) 1064 endof 1065 fzap# of 1066 ['] fz-print -rot ( xt dn fz ) 1067 fzap-apply ( false ) 1068 endof 1069 3drop false ( false ) 1070 endcase ( false ) 1071 drop ( ) 1072 ; 1073 1074 1075 \ 1076 \ ZFS object set (DSL) routines 1077 \ 1078 1079 1 constant pool-dir# 1080 1081 : dd_head_dataset_obj ( dd -- n ) h# 8 + x@ ; 1082 : dd_child_dir_zapobj ( dd -- n ) h# 20 + x@ ; 1083 1084 : ds_snapnames_zapobj ( ds -- n ) h# 20 + x@ ; 1085 : ds_bp ( ds -- p ) h# 80 + ; 1086 1087 0 instance value mos-dn 1088 0 instance value obj-dir 1089 0 instance value root-dsl 1090 0 instance value fs-dn 1091 1092 \ dn-cache contains dc-dn's contents at dc-blk# 1093 \ dc-dn will be either mos-dn or fs-dn 1094 0 instance value dn-cache 1095 0 instance value dc-dn 1096 0 instance value dc-blk# 1097 1098 alias >dsl-dir dn_bonus 1099 alias >dsl-ds dn_bonus 1100 1101 : #dn/blk ( dn -- n ) dn-bsize /dnode / ; 1102 1103 \ read block into dn-cache 1104 : get-dnblk ( dn blk# -- ) 1105 lblk#>bp dn-cache swap ( adr bp ) 1106 dup bp-lsize swap read-bp ( ) 1107 ; 1108 1109 \ read obj# from objset dir dn into dnode 1110 : get-dnode ( dn obj# -- ) 1111 1112 \ check dn-cache 1113 2dup swap #dn/blk /mod ( dn obj# off# blk# ) 1114 swap >r nip ( dn blk# r: off# ) 1115 2dup dc-blk# <> ( dn blk# dn !blk-hit? r: off# ) 1116 swap dc-dn <> or if ( dn blk# r: off# ) 1117 \ cache miss, fill from dir 1118 2dup get-dnblk 1119 over to dc-dn 1120 dup to dc-blk# 1121 then ( dn blk# r: off# ) 1122 1123 \ index and copy 1124 2drop r> /dnode * ( off ) 1125 dn-cache + ( dn-adr ) 1126 dnode /dnode move ( ) 1127 ; 1128 1129 \ read meta object set from uber-block 1130 : get-mos ( -- ) 1131 mos-dn uber-block ub_rootbp ( adr bp ) 1132 dup bp-lsize swap read-bp 1133 ; 1134 1135 : get-mos-dnode ( obj# -- ) 1136 mos-dn swap get-dnode 1137 ; 1138 1139 \ get root dataset 1140 : get-root-dsl ( -- ) 1141 1142 \ read MOS 1143 get-mos 1144 1145 \ read object dir 1146 pool-dir# get-mos-dnode 1147 dnode obj-dir /dnode move 1148 1149 \ read root dataset 1150 obj-dir " root_dataset" zap-lookup if 1151 " no root_dataset" die 1152 then ( obj# ) 1153 get-mos-dnode ( ) 1154 dnode root-dsl /dnode move 1155 ; 1156 1157 \ find snapshot of given dataset 1158 : snap-look ( snap$ ds-obj# -- [ss-obj# ] not-found? ) 1159 get-mos-dnode dnode >dsl-ds ( snap$ ds ) 1160 ds_snapnames_zapobj get-mos-dnode ( snap$ ) 1161 dnode -rot zap-lookup ( [ss-obj# ] not-found? ) 1162 ; 1163 1164 \ dsl dir to dataset 1165 : dir>ds ( dn -- obj# ) >dsl-dir dd_head_dataset_obj ; 1166 1167 \ look thru the dsl hierarchy for path 1168 \ this looks almost exactly like a FS directory lookup 1169 : dsl-lookup ( path$ -- [ ds-obj# ] not-found? ) 1170 root-dsl >r ( path$ r: root-dn ) 1171 begin 1172 ascii / left-parse-string ( path$ file$ r: dn ) 1173 dup while 1174 1175 \ get child dir zap dnode 1176 r> >dsl-dir dd_child_dir_zapobj ( path$ file$ obj# ) 1177 get-mos-dnode ( path$ file$ ) 1178 1179 \ check for snapshot names 1180 ascii @ left-parse-string ( path$ snap$ file$ ) 1181 1182 \ search it 1183 dnode -rot zap-lookup if ( path$ snap$ ) 1184 \ not found 1185 2drop 2drop true exit ( not-found ) 1186 then ( path$ snap$ obj# ) 1187 get-mos-dnode ( path$ snap$ ) 1188 1189 \ lookup any snapshot name 1190 dup if 1191 \ must be last path component 1192 2swap nip if ( snap$ ) 1193 2drop true exit ( not-found ) 1194 then 1195 dnode dir>ds snap-look if ( ) 1196 true exit ( not-found ) 1197 then ( obj# ) 1198 false exit ( obj# found ) 1199 else 2drop then ( path$ ) 1200 1201 dnode >r ( path$ r: dn ) 1202 repeat ( path$ file$ r: dn) 1203 2drop 2drop r> drop ( ) 1204 1205 \ found it, return dataset obj# 1206 dnode dir>ds ( ds-obj# ) 1207 false ( ds-obj# found ) 1208 ; 1209 1210 \ get objset from dataset 1211 : get-objset ( adr dn -- ) 1212 >dsl-ds ds_bp dup bp-lsize swap read-bp 1213 ; 1214 1215 1216 \ 1217 \ ZFS file-system (ZPL) routines 1218 \ 1219 1220 1 constant master-node# 1221 1222 0 instance value bootfs-obj# 1223 0 instance value root-obj# 1224 0 instance value current-obj# 1225 0 instance value search-obj# 1226 1227 instance defer fsize ( dn -- size ) 1228 instance defer mode ( dn -- mode ) 1229 instance defer parent ( dn -- obj# ) 1230 instance defer readlink ( dst dn -- ) 1231 1232 \ 1233 \ routines when bonus pool contains a znode 1234 \ 1235 d# 264 constant /znode 1236 d# 56 constant /zn-slink 1237 1238 : zp_mode ( zn -- n ) h# 48 + x@ ; 1239 : zp_size ( zn -- n ) h# 50 + x@ ; 1240 : zp_parent ( zn -- n ) h# 58 + x@ ; 1241 1242 alias >znode dn_bonus 1243 1244 : zn-fsize ( dn -- n ) >znode zp_size ; 1245 : zn-mode ( dn -- n ) >znode zp_mode ; 1246 : zn-parent ( dn -- n ) >znode zp_parent ; 1247 1248 \ copy symlink target to dst 1249 : zn-readlink ( dst dn -- ) 1250 dup zn-fsize tuck /zn-slink > if ( dst size dn ) 1251 \ contents in 1st block 1252 temp-space over dn-bsize ( dst size dn t-adr bsize ) 1253 rot 0 lblk#>bp read-bp ( dst size ) 1254 temp-space ( dst size src ) 1255 else ( dst size dn ) 1256 \ contents in dnode 1257 >znode /znode + ( dst size src ) 1258 then ( dst size src ) 1259 -rot move ( ) 1260 ; 1261 1262 \ 1263 \ routines when bonus pool contains sa's 1264 \ 1265 1266 \ SA header size when link is in dn_bonus 1267 d# 16 constant /sahdr-link 1268 1269 : sa_props ( sa -- n ) h# 4 + w@ ; 1270 1271 : sa-hdrsz ( sa -- sz ) sa_props h# 7 >> ; 1272 1273 alias >sa dn_bonus 1274 1275 : >sadata ( dn -- adr ) >sa dup sa-hdrsz + ; 1276 : sa-mode ( dn -- n ) >sadata x@ ; 1277 : sa-fsize ( dn -- n ) >sadata h# 8 + x@ ; 1278 : sa-parent ( dn -- n ) >sadata h# 28 + x@ ; 1279 1280 \ copy symlink target to dst 1281 : sa-readlink ( dst dn -- ) 1282 dup >sa sa-hdrsz /sahdr-link <> if 1283 \ contents in 1st attr of dn_spill 1284 temp-space over dn_spill ( dst dn t-adr bp ) 1285 dup bp-lsize swap read-bp ( dst dn ) 1286 sa-fsize ( dst size ) 1287 temp-space dup sa-hdrsz + ( dst size src ) 1288 else ( dst dn ) 1289 \ content in bonus buf 1290 dup dn_bonus over dn_bonuslen + ( dst dn ebonus ) 1291 swap sa-fsize tuck - ( dst size src ) 1292 then ( dst size src ) 1293 -rot move ( ) 1294 ; 1295 1296 1297 \ setup attr routines for dn 1298 : set-attr ( dn -- ) 1299 dn_bonustype ot-sa# = if 1300 ['] sa-fsize to fsize 1301 ['] sa-mode to mode 1302 ['] sa-parent to parent 1303 ['] sa-readlink to readlink 1304 else 1305 ['] zn-fsize to fsize 1306 ['] zn-mode to mode 1307 ['] zn-parent to parent 1308 ['] zn-readlink to readlink 1309 then 1310 ; 1311 1312 : ftype ( dn -- type ) mode h# f000 and ; 1313 : dir? ( dn -- flag ) ftype h# 4000 = ; 1314 : symlink? ( dn -- flag ) ftype h# a000 = ; 1315 1316 \ read obj# from fs objset 1317 : get-fs-dnode ( obj# -- ) 1318 dup to current-obj# 1319 fs-dn swap get-dnode ( ) 1320 ; 1321 1322 \ get root-obj# from dataset 1323 : get-rootobj# ( ds-obj# -- fsroot-obj# ) 1324 dup to bootfs-obj# 1325 get-mos-dnode ( ) 1326 fs-dn dnode get-objset 1327 1328 \ get root obj# from master node 1329 master-node# get-fs-dnode 1330 dnode " ROOT" zap-lookup if 1331 " no ROOT" die 1332 then ( fsroot-obj# ) 1333 ; 1334 1335 : prop>rootobj# ( -- ) 1336 obj-dir " pool_props" zap-lookup if 1337 " no pool_props" die 1338 then ( prop-obj# ) 1339 get-mos-dnode ( ) 1340 dnode " bootfs" zap-lookup if 1341 " no bootfs" die 1342 then ( ds-obj# ) 1343 get-rootobj# ( fsroot-obj# ) 1344 ; 1345 1346 : fs>rootobj# ( fs$ -- root-obj# not-found? ) 1347 1348 \ skip pool name 1349 ascii / left-parse-string 2drop 1350 1351 \ lookup fs in dsl 1352 dsl-lookup if ( ) 1353 true exit ( not-found ) 1354 then ( ds-obj# ) 1355 1356 get-rootobj# ( fsroot-obj# ) 1357 false ( fsroot-obj# found ) 1358 ; 1359 1360 \ lookup file is current directory 1361 : dirlook ( file$ dn -- not-found? ) 1362 \ . and .. are magic 1363 -rot 2dup " ." $= if ( dn file$ ) 1364 3drop false exit ( found ) 1365 then 1366 1367 2dup " .." $= if 1368 2drop parent ( obj# ) 1369 else ( dn file$ ) 1370 \ search dir 1371 current-obj# to search-obj# 1372 zap-lookup if ( ) 1373 true exit ( not-found ) 1374 then ( obj# ) 1375 then ( obj# ) 1376 get-fs-dnode 1377 dnode set-attr 1378 false ( found ) 1379 ; 1380 1381 /buf-len instance buffer: fpath-buf 1382 /buf-len instance buffer: tpath-buf 1383 1384 : tpath-buf$ ( -- path$ ) tpath-buf cscount ; 1385 : fpath-buf$ ( -- path$ ) fpath-buf cscount ; 1386 1387 \ modify tail to account for symlink 1388 : follow-symlink ( tail$ -- tail$' ) 1389 \ read target 1390 tpath-buf /buf-len erase 1391 tpath-buf dnode readlink 1392 1393 \ append current path 1394 ?dup if ( tail$ ) 1395 " /" tpath-buf$ $append ( tail$ ) 1396 tpath-buf$ $append ( ) 1397 else drop then ( ) 1398 1399 \ copy to fpath 1400 fpath-buf /buf-len erase 1401 tpath-buf$ fpath-buf swap move 1402 fpath-buf$ ( path$ ) 1403 1404 \ get directory that starts changed path 1405 over c@ ascii / = if ( path$ ) 1406 str++ root-obj# ( path$' obj# ) 1407 else ( path$ ) 1408 search-obj# ( path$ obj# ) 1409 then ( path$ obj# ) 1410 get-fs-dnode ( path$ ) 1411 dnode set-attr 1412 ; 1413 1414 \ open dnode at path 1415 : lookup ( path$ -- not-found? ) 1416 1417 \ get directory that starts path 1418 over c@ ascii / = if 1419 str++ root-obj# ( path$' obj# ) 1420 else 1421 current-obj# ( path$ obj# ) 1422 then ( path$ obj# ) 1423 get-fs-dnode ( path$ ) 1424 dnode set-attr 1425 1426 \ lookup each path component 1427 begin ( path$ ) 1428 ascii / left-parse-string ( path$ file$ ) 1429 dup while 1430 dnode dir? 0= if 1431 2drop true exit ( not-found ) 1432 then ( path$ file$ ) 1433 dnode dirlook if ( path$ ) 1434 2drop true exit ( not-found ) 1435 then ( path$ ) 1436 dnode symlink? if 1437 follow-symlink ( path$' ) 1438 then ( path$ ) 1439 repeat ( path$ file$ ) 1440 2drop 2drop false ( found ) 1441 ; 1442 1443 \ 1444 \ ZFS volume (ZVOL) routines 1445 \ 1446 1 constant zvol-data# 1447 2 constant zvol-prop# 1448 1449 0 instance value zv-dn 1450 1451 : get-zvol ( zvol$ -- not-found? ) 1452 dsl-lookup if 1453 drop true exit ( failed ) 1454 then ( ds-obj# ) 1455 1456 \ get zvol objset 1457 get-mos-dnode ( ) 1458 zv-dn dnode get-objset 1459 false ( succeeded ) 1460 ; 1461 1462 \ get zvol data dnode 1463 : zvol-data ( -- ) 1464 zv-dn zvol-data# get-dnode 1465 ; 1466 1467 : zvol-size ( -- size ) 1468 zv-dn zvol-prop# get-dnode 1469 dnode " size" zap-lookup if 1470 " no zvol size" die 1471 then ( size ) 1472 ; 1473 1474 1475 \ 1476 \ ZFS installation routines 1477 \ 1478 1479 \ ZFS file interface 1480 struct 1481 /x field >busy 1482 /x field >offset 1483 /x field >fsize 1484 /dnode field >dnode 1485 constant /file-record 1486 1487 d# 10 constant #opens 1488 #opens /file-record * constant /file-records 1489 1490 /file-records instance buffer: file-records 1491 1492 -1 instance value current-fd 1493 1494 : fd>record ( fd -- rec ) /file-record * file-records + ; 1495 : file-offset@ ( -- off ) current-fd fd>record >offset x@ ; 1496 : file-offset! ( off -- ) current-fd fd>record >offset x! ; 1497 : file-dnode ( -- dn ) current-fd fd>record >dnode ; 1498 : file-size ( -- size ) current-fd fd>record >fsize x@ ; 1499 : file-bsize ( -- bsize ) file-dnode dn-bsize ; 1500 1501 \ find free fd slot 1502 : get-slot ( -- fd false | true ) 1503 #opens 0 do 1504 i fd>record >busy x@ 0= if 1505 i false unloop exit 1506 then 1507 loop true 1508 ; 1509 1510 : free-slot ( fd -- ) 1511 0 swap fd>record >busy x! 1512 ; 1513 1514 \ init fd to offset 0 and copy dnode 1515 : init-fd ( fsize fd -- ) 1516 fd>record ( fsize rec ) 1517 dup >busy 1 swap x! 1518 dup >dnode dnode swap /dnode move 1519 dup >fsize rot swap x! ( rec ) 1520 >offset 0 swap x! ( ) 1521 ; 1522 1523 \ make fd current 1524 : set-fd ( fd -- error? ) 1525 dup fd>record >busy x@ 0= if ( fd ) 1526 drop true exit ( failed ) 1527 then ( fd ) 1528 to current-fd false ( succeeded ) 1529 ; 1530 1531 \ read next fs block 1532 : file-bread ( adr -- ) 1533 file-bsize ( adr len ) 1534 file-offset@ over / ( adr len blk# ) 1535 file-dnode swap lblk#>bp ( adr len bp ) 1536 read-bp ( ) 1537 ; 1538 1539 \ advance file io stack by n 1540 : fio+ ( # adr len n -- #+n adr+n len-n ) 1541 dup file-offset@ + file-offset! 1542 dup >r - -rot ( len' # adr r: n ) 1543 r@ + -rot ( adr' len' # r: n ) 1544 r> + -rot ( #' adr' len' ) 1545 ; 1546 1547 1548 /max-bsize 5 * 1549 /uber-block + 1550 /dnode 6 * + 1551 /disk-block 6 * + ( size ) 1552 \ ugh - sg proms can't free 512k allocations 1553 \ that aren't a multiple of 512k in size 1554 h# 8.0000 roundup ( size' ) 1555 constant alloc-size 1556 1557 1558 : allocate-buffers ( -- ) 1559 alloc-size h# a0.0000 vmem-alloc dup 0= if 1560 " no memory" die 1561 then ( adr ) 1562 dup to temp-space /max-bsize + ( adr ) 1563 dup to dn-cache /max-bsize + ( adr ) 1564 dup to blk-space /max-bsize + ( adr ) 1565 dup to ind-cache /max-bsize + ( adr ) 1566 dup to zap-space /max-bsize + ( adr ) 1567 dup to uber-block /uber-block + ( adr ) 1568 dup to mos-dn /dnode + ( adr ) 1569 dup to obj-dir /dnode + ( adr ) 1570 dup to root-dsl /dnode + ( adr ) 1571 dup to fs-dn /dnode + ( adr ) 1572 dup to zv-dn /dnode + ( adr ) 1573 dup to dnode /dnode + ( adr ) 1574 to gang-space ( ) 1575 1576 \ zero instance buffers 1577 file-records /file-records erase 1578 bootprop-buf /buf-len erase 1579 ; 1580 1581 : release-buffers ( -- ) 1582 temp-space alloc-size mem-free 1583 ; 1584 1585 external 1586 1587 : open ( -- okay? ) 1588 my-args dev-open dup 0= if 1589 exit ( failed ) 1590 then to dev-ih 1591 1592 allocate-buffers 1593 scan-vdev 1594 get-ub 1595 get-root-dsl 1596 true 1597 ; 1598 1599 : open-fs ( fs$ -- okay? ) 1600 fs>rootobj# if ( ) 1601 false ( failed ) 1602 else ( obj# ) 1603 to root-obj# true ( succeeded ) 1604 then ( okay? ) 1605 ; 1606 1607 : close ( -- ) 1608 dev-ih dev-close 1609 0 to dev-ih 1610 release-buffers 1611 ; 1612 1613 : open-file ( path$ -- fd true | false ) 1614 1615 \ open default fs if no open-fs 1616 root-obj# 0= if 1617 prop>rootobj# to root-obj# 1618 then 1619 1620 get-slot if 1621 2drop false exit ( failed ) 1622 then -rot ( fd path$ ) 1623 1624 lookup if ( fd ) 1625 drop false exit ( failed ) 1626 then ( fd ) 1627 1628 dnode fsize over init-fd 1629 true ( fd succeeded ) 1630 ; 1631 1632 : open-volume ( vol$ -- okay? ) 1633 get-slot if 1634 2drop false exit ( failed ) 1635 then -rot ( fd vol$ ) 1636 1637 get-zvol if ( fd ) 1638 drop false exit ( failed ) 1639 then 1640 1641 zvol-size over ( fd size fd ) 1642 zvol-data init-fd ( fd ) 1643 true ( fd succeeded ) 1644 ; 1645 1646 : close-file ( fd -- ) 1647 free-slot ( ) 1648 ; 1649 1650 : size-file ( fd -- size ) 1651 set-fd if 0 else file-size then 1652 ; 1653 1654 : seek-file ( off fd -- off true | false ) 1655 set-fd if ( off ) 1656 drop false exit ( failed ) 1657 then ( off ) 1658 1659 dup file-size x> if ( off ) 1660 drop false exit ( failed ) 1661 then ( off ) 1662 dup file-offset! true ( off succeeded ) 1663 ; 1664 1665 : read-file ( adr len fd -- #read ) 1666 set-fd if ( adr len ) 1667 2drop 0 exit ( 0 ) 1668 then ( adr len ) 1669 1670 \ adjust len if reading past eof 1671 dup file-offset@ + file-size x> if 1672 dup file-offset@ + file-size - - 1673 then 1674 dup 0= if nip exit then 1675 1676 0 -rot ( #read adr len ) 1677 1678 \ initial partial block 1679 file-offset@ file-bsize mod ?dup if ( #read adr len off ) 1680 temp-space file-bread 1681 2dup file-bsize swap - min ( #read adr len off cpy-len ) 1682 2over drop -rot ( #read adr len adr off cpy-len ) 1683 >r temp-space + swap ( #read adr len cpy-src adr r: cpy-len ) 1684 r@ move r> fio+ ( #read' adr' len' ) 1685 then ( #read adr len ) 1686 1687 dup file-bsize / 0 ?do ( #read adr len ) 1688 over file-bread 1689 file-bsize fio+ ( #read' adr' len' ) 1690 loop ( #read adr len ) 1691 1692 \ final partial block 1693 dup if ( #read adr len ) 1694 temp-space file-bread 1695 2dup temp-space -rot move ( #read adr len ) 1696 dup fio+ ( #read' adr' 0 ) 1697 then 2drop ( #read ) 1698 ; 1699 1700 : cinfo-file ( fd -- bsize fsize comp? ) 1701 set-fd if 1702 0 0 0 1703 else 1704 file-bsize file-size ( bsize fsize ) 1705 \ zfs does internal compression 1706 0 ( bsize fsize comp? ) 1707 then 1708 ; 1709 1710 \ read ramdisk fcode at rd-offset 1711 : get-rd ( adr len -- ) 1712 rd-offset dev-ih read-disk 1713 ; 1714 1715 : bootprop 1716 " /" bootprop$ $append 1717 bootfs-obj# (xu.) bootprop$ $append 1718 bootprop$ encode-string " zfs-bootfs" ( propval propname ) 1719 true 1720 ; 1721 1722 1723 : chdir ( dir$ -- ) 1724 current-obj# -rot ( obj# dir$ ) 1725 lookup if ( obj# ) 1726 to current-obj# ( ) 1727 ." no such dir" cr exit 1728 then ( obj# ) 1729 dnode dir? 0= if ( obj# ) 1730 to current-obj# ( ) 1731 ." not a dir" cr exit 1732 then drop ( ) 1733 ; 1734 1735 : dir ( -- ) 1736 current-obj# get-fs-dnode 1737 dnode zap-print 1738 ; 1739 1740finish-device 1741pop-package 1742