Annotation of qemu/roms/SLOF/slof/fs/packages/ext2-files.fs, revision 1.1.1.2

1.1       root        1: \ *****************************************************************************
1.1.1.2 ! root        2: \ * Copyright (c) 2004, 2011 IBM Corporation
1.1       root        3: \ * All rights reserved.
                      4: \ * This program and the accompanying materials
                      5: \ * are made available under the terms of the BSD License
                      6: \ * which accompanies this distribution, and is available at
                      7: \ * http://www.opensource.org/licenses/bsd-license.php
                      8: \ *
                      9: \ * Contributors:
                     10: \ *     IBM Corporation - initial implementation
                     11: \ ****************************************************************************/
                     12: s" ext2-files" device-name
                     13: 
                     14: INSTANCE VARIABLE first-block
1.1.1.2 ! root       15: INSTANCE VARIABLE inode-size
1.1       root       16: INSTANCE VARIABLE block-size
                     17: INSTANCE VARIABLE inodes/group
                     18: 
1.1.1.2 ! root       19: INSTANCE VARIABLE group-desc-size
1.1       root       20: INSTANCE VARIABLE group-descriptors
                     21: 
                     22: : seek  s" seek" $call-parent ;
                     23: : read  s" read" $call-parent ;
                     24: 
                     25: INSTANCE VARIABLE data
                     26: INSTANCE VARIABLE #data
1.1.1.2 ! root       27: INSTANCE VARIABLE indirect-block
        !            28: INSTANCE VARIABLE dindirect-block
1.1       root       29: 
                     30: : free-data
                     31:   data @ ?dup IF #data @ free-mem  0 data ! THEN ;
                     32: : read-data ( offset size -- )
                     33:   free-data  dup #data ! alloc-mem data !
                     34:   xlsplit seek            -2 and ABORT" ext2-files read-data: seek failed"
                     35:   data @ #data @ read #data @ <> ABORT" ext2-files read-data: read failed" ;
                     36: 
                     37: : read-block ( block# -- )
                     38:   block-size @ * block-size @ read-data ;
                     39: 
                     40: INSTANCE VARIABLE inode
                     41: INSTANCE VARIABLE file-len
                     42: INSTANCE VARIABLE blocks
                     43: INSTANCE VARIABLE #blocks
                     44: INSTANCE VARIABLE ^blocks
                     45: INSTANCE VARIABLE #blocks-left
                     46: : blocks-read ( n -- )  dup negate #blocks-left +! 4 * ^blocks +! ;
                     47: : read-indirect-blocks ( indirect-block# -- )
                     48:   read-block data @ data off
                     49:   dup #blocks-left @ 4 * block-size @ min dup >r ^blocks @ swap move
                     50:   r> 2 rshift blocks-read block-size @ free-mem ;
1.1.1.2 ! root       51: 
1.1       root       52: : read-double-indirect-blocks ( double-indirect-block# -- )
1.1.1.2 ! root       53:    \ Resolve one level of indirection and call read-indirect-block
        !            54:    read-block data @ indirect-block ! data off
        !            55:    BEGIN
        !            56:       indirect-block @ l@-le dup 0 <>
        !            57:    WHILE
        !            58:       read-indirect-blocks
        !            59:       4 indirect-block +!       \ point to next indirect block
        !            60:    REPEAT
        !            61:    drop                         \ drop 0, the invalid block number
1.1       root       62: ;
1.1.1.2 ! root       63: 
1.1       root       64: : read-triple-indirect-blocks ( triple-indirect-block# -- )
1.1.1.2 ! root       65:    \ Resolve one level of indirection and call double-indirect-block
        !            66:    read-block data @ dindirect-block ! data off
        !            67:    BEGIN
        !            68:       dindirect-block @ l@-le dup 0 <>
        !            69:    WHILE
        !            70:       read-double-indirect-blocks
        !            71:       4 dindirect-block +!      \ point to next double indirect block
        !            72:    REPEAT
        !            73:    drop                         \ drop 0, the invalid block number
1.1       root       74: ;
1.1.1.2 ! root       75: 
1.1       root       76: : read-block#s ( -- )
                     77:   blocks @ ?dup IF #blocks @ 4 * free-mem THEN
                     78:   inode @ 4 + l@-le file-len !
                     79:   file-len @ block-size @ // #blocks !
                     80:   #blocks @ 4 * alloc-mem blocks !
                     81:   blocks @ ^blocks !  #blocks @ #blocks-left !
                     82:   #blocks-left @ c min \ # direct blocks
                     83:   inode @ 28 + over 4 * ^blocks @ swap move blocks-read
                     84:   #blocks-left @ IF inode @ 58 + l@-le read-indirect-blocks THEN
                     85:   #blocks-left @ IF inode @ 5c + l@-le read-double-indirect-blocks THEN
                     86:   #blocks-left @ IF inode @ 60 + l@-le read-triple-indirect-blocks THEN ;
                     87: : read-inode ( inode# -- )
                     88:   1- inodes/group @ u/mod \ # in group, group #
                     89:   20 * group-descriptors @ + 8 + l@-le block-size @ * \ # in group, inode table
1.1.1.2 ! root       90:   swap inode-size @ * + xlsplit seek drop  inode @ inode-size @ read drop
        !            91: ;
1.1       root       92: 
                     93: : .rwx ( bits last-char-if-special special? -- )
                     94:   rot dup 4 and IF ." r" ELSE ." -" THEN
                     95:       dup 2 and IF ." w" ELSE ." -" THEN
                     96:   swap IF 1 and 0= IF upc THEN emit ELSE
                     97:           1 and IF ." x" ELSE ." -" THEN drop THEN ;
                     98: CREATE mode-chars 10 allot s" ?pc?d?b?-?l?s???" mode-chars swap move
                     99: : .mode ( mode -- )
                    100:   dup c rshift f and mode-chars + c@ emit
                    101:   dup 6 rshift 7 and over 800 and 73 swap .rwx
                    102:   dup 3 rshift 7 and over 400 and 73 swap .rwx
                    103:   dup          7 and swap 200 and 74 swap .rwx ;
                    104: : .inode ( -- )
                    105:   base @ >r decimal
                    106:   inode @      w@-le .mode \ file mode
                    107:   inode @ 1a + w@-le 5 .r \ link count
                    108:   inode @ 02 + w@-le 9 .r \ uid
                    109:   inode @ 18 + w@-le 9 .r \ gid
                    110:   inode @ 04 + l@-le 9 .r \ size
                    111:   r> base ! ;
                    112: 
                    113: : do-super ( -- )
                    114:   400 400 read-data
                    115:   data @ 14 + l@-le first-block !
                    116:   400 data @ 18 + l@-le lshift block-size !
                    117:   data @ 28 + l@-le inodes/group !
1.1.1.2 ! root      118:   \ Check revision level... in revision 0, the inode size is always 128
        !           119:   data @ 4c + l@-le 0= IF
        !           120:      80 inode-size !
        !           121:   ELSE
        !           122:      data @ 58 + w@-le inode-size !
        !           123:   THEN
        !           124:   data @ 20 + l@-le group-desc-size !
        !           125: 
        !           126:   \ Read the group descriptor table:
        !           127:   first-block @ 1+ block-size @ *
        !           128:   group-desc-size @
        !           129:   read-data
        !           130:   data @ group-descriptors !
        !           131: 
        !           132:   \ We keep the group-descriptor memory area, so clear data pointer:
        !           133:   data off
        !           134: ;
1.1       root      135: 
                    136: INSTANCE VARIABLE current-pos
                    137: 
                    138: : read ( adr len -- actual )
                    139:   file-len @ current-pos @ - min \ can't go past end of file
                    140:   current-pos @ block-size @ u/mod 4 * blocks @ + l@-le read-block
                    141:   block-size @ over - rot min >r ( adr off r: len )
                    142:   data @ + swap r@ move r> dup current-pos +! ;
                    143: : read ( adr len -- actual )
                    144:   ( check if a file is selected, first )
                    145:   dup >r BEGIN dup WHILE 2dup read dup 0= ABORT" ext2-files: read failed"
                    146:   /string REPEAT 2drop r> ;
                    147: : seek ( lo hi -- status )
                    148:   lxjoin dup file-len @ > IF drop true EXIT THEN current-pos ! false ;
                    149: : load ( adr -- len )
                    150:   file-len @ read dup file-len @ <> ABORT" ext2-files: failed loading file" ;
                    151: 
                    152: : .name ( adr -- )  dup 8 + swap 6 + c@ type ;
                    153: : read-dir ( inode# -- adr )
                    154:   read-inode read-block#s file-len @ alloc-mem
                    155:   0 0 seek ABORT" ext2-files read-dir: seek failed"
                    156:   dup file-len @ read file-len @ <> ABORT" ext2-files read-dir: read failed" ;
                    157: : .dir ( inode# -- )
                    158:   read-dir dup BEGIN 2dup file-len @ - > over l@-le tuck and WHILE
                    159:   cr dup 8 0.r space read-inode .inode space space dup .name
                    160:   dup 4 + w@-le + REPEAT 2drop file-len @ free-mem ;
                    161: : (find-file) ( adr name len -- inode#|0 )
                    162:   2>r dup BEGIN 2dup file-len @ - > over l@-le and WHILE
                    163:   dup 8 + over 6 + c@ 2r@ str= IF 2r> 2drop nip l@-le EXIT THEN
                    164:   dup 4 + w@-le + REPEAT 2drop 2r> 2drop 0 ;
                    165: : find-file ( inode# name len -- inode#|0 )
                    166:   2>r read-dir dup 2r> (find-file) swap file-len @ free-mem ;
                    167: : find-path ( inode# name len -- inode#|0 )
                    168:   dup 0= IF 3drop 0 ."  empty name " EXIT THEN
                    169:   over c@ [char] \ = IF 1 /string ."  slash " RECURSE EXIT THEN
                    170:   [char] \ split 2>r find-file ?dup 0= IF
                    171:   2r> 2drop false ."  not found " EXIT THEN
                    172:   r@ 0<> IF 2r> ."  more... " RECURSE EXIT THEN
                    173:   2r> 2drop ."  got it " ;
1.1.1.2 ! root      174: 
        !           175: : close
        !           176:    inode @ inode-size @ free-mem
        !           177:    group-descriptors @ group-desc-size @ free-mem
        !           178:    free-data
        !           179:    blocks @ ?dup IF #blocks @ 4 * free-mem THEN
        !           180: ;
        !           181: 
1.1       root      182: : open
1.1.1.2 ! root      183:   0 data ! 0 blocks ! 0 #blocks !
1.1       root      184:   do-super
1.1.1.2 ! root      185:   inode-size @ alloc-mem inode !
1.1       root      186:   my-args nip 0= IF 0 0 ELSE
                    187:   2 my-args find-path ?dup 0= IF close false EXIT THEN THEN
                    188:   read-inode read-block#s 0 0 seek 0= ;

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.