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

1.1     ! root        1: \ *****************************************************************************
        !             2: \ * Copyright (c) 2004, 2008 IBM Corporation
        !             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
        !            15: INSTANCE VARIABLE block-size
        !            16: INSTANCE VARIABLE inodes/group
        !            17: 
        !            18: INSTANCE VARIABLE group-descriptors
        !            19: 
        !            20: : seek  s" seek" $call-parent ;
        !            21: : read  s" read" $call-parent ;
        !            22: 
        !            23: INSTANCE VARIABLE data
        !            24: INSTANCE VARIABLE #data
        !            25: 
        !            26: : free-data
        !            27:   data @ ?dup IF #data @ free-mem  0 data ! THEN ;
        !            28: : read-data ( offset size -- )
        !            29:   free-data  dup #data ! alloc-mem data !
        !            30:   xlsplit seek            -2 and ABORT" ext2-files read-data: seek failed"
        !            31:   data @ #data @ read #data @ <> ABORT" ext2-files read-data: read failed" ;
        !            32: 
        !            33: : read-block ( block# -- )
        !            34:   block-size @ * block-size @ read-data ;
        !            35: 
        !            36: INSTANCE VARIABLE inode
        !            37: INSTANCE VARIABLE file-len
        !            38: INSTANCE VARIABLE blocks
        !            39: INSTANCE VARIABLE #blocks
        !            40: INSTANCE VARIABLE ^blocks
        !            41: INSTANCE VARIABLE #blocks-left
        !            42: : blocks-read ( n -- )  dup negate #blocks-left +! 4 * ^blocks +! ;
        !            43: : read-indirect-blocks ( indirect-block# -- )
        !            44:   read-block data @ data off
        !            45:   dup #blocks-left @ 4 * block-size @ min dup >r ^blocks @ swap move
        !            46:   r> 2 rshift blocks-read block-size @ free-mem ;
        !            47: : read-double-indirect-blocks ( double-indirect-block# -- )
        !            48: \ TBD
        !            49: ;
        !            50: : read-triple-indirect-blocks ( triple-indirect-block# -- )
        !            51: \ TBD
        !            52: ;
        !            53: : read-block#s ( -- )
        !            54:   blocks @ ?dup IF #blocks @ 4 * free-mem THEN
        !            55:   inode @ 4 + l@-le file-len !
        !            56:   file-len @ block-size @ // #blocks !
        !            57:   #blocks @ 4 * alloc-mem blocks !
        !            58:   blocks @ ^blocks !  #blocks @ #blocks-left !
        !            59:   #blocks-left @ c min \ # direct blocks
        !            60:   inode @ 28 + over 4 * ^blocks @ swap move blocks-read
        !            61:   #blocks-left @ IF inode @ 58 + l@-le read-indirect-blocks THEN
        !            62:   #blocks-left @ IF inode @ 5c + l@-le read-double-indirect-blocks THEN
        !            63:   #blocks-left @ IF inode @ 60 + l@-le read-triple-indirect-blocks THEN ;
        !            64: : read-inode ( inode# -- )
        !            65:   1- inodes/group @ u/mod \ # in group, group #
        !            66:   20 * group-descriptors @ + 8 + l@-le block-size @ * \ # in group, inode table
        !            67:   swap 80 * + xlsplit seek drop  inode @ 80 read drop ;
        !            68: 
        !            69: : .rwx ( bits last-char-if-special special? -- )
        !            70:   rot dup 4 and IF ." r" ELSE ." -" THEN
        !            71:       dup 2 and IF ." w" ELSE ." -" THEN
        !            72:   swap IF 1 and 0= IF upc THEN emit ELSE
        !            73:           1 and IF ." x" ELSE ." -" THEN drop THEN ;
        !            74: CREATE mode-chars 10 allot s" ?pc?d?b?-?l?s???" mode-chars swap move
        !            75: : .mode ( mode -- )
        !            76:   dup c rshift f and mode-chars + c@ emit
        !            77:   dup 6 rshift 7 and over 800 and 73 swap .rwx
        !            78:   dup 3 rshift 7 and over 400 and 73 swap .rwx
        !            79:   dup          7 and swap 200 and 74 swap .rwx ;
        !            80: : .inode ( -- )
        !            81:   base @ >r decimal
        !            82:   inode @      w@-le .mode \ file mode
        !            83:   inode @ 1a + w@-le 5 .r \ link count
        !            84:   inode @ 02 + w@-le 9 .r \ uid
        !            85:   inode @ 18 + w@-le 9 .r \ gid
        !            86:   inode @ 04 + l@-le 9 .r \ size
        !            87:   r> base ! ;
        !            88: 
        !            89: : do-super ( -- )
        !            90:   400 400 read-data
        !            91:   data @ 14 + l@-le first-block !
        !            92:   400 data @ 18 + l@-le lshift block-size !
        !            93:   data @ 28 + l@-le inodes/group !
        !            94:   first-block @ 1+ read-block data @ group-descriptors ! data off ;
        !            95: 
        !            96: INSTANCE VARIABLE current-pos
        !            97: 
        !            98: : read ( adr len -- actual )
        !            99:   file-len @ current-pos @ - min \ can't go past end of file
        !           100:   current-pos @ block-size @ u/mod 4 * blocks @ + l@-le read-block
        !           101:   block-size @ over - rot min >r ( adr off r: len )
        !           102:   data @ + swap r@ move r> dup current-pos +! ;
        !           103: : read ( adr len -- actual )
        !           104:   ( check if a file is selected, first )
        !           105:   dup >r BEGIN dup WHILE 2dup read dup 0= ABORT" ext2-files: read failed"
        !           106:   /string REPEAT 2drop r> ;
        !           107: : seek ( lo hi -- status )
        !           108:   lxjoin dup file-len @ > IF drop true EXIT THEN current-pos ! false ;
        !           109: : load ( adr -- len )
        !           110:   file-len @ read dup file-len @ <> ABORT" ext2-files: failed loading file" ;
        !           111: 
        !           112: : .name ( adr -- )  dup 8 + swap 6 + c@ type ;
        !           113: : read-dir ( inode# -- adr )
        !           114:   read-inode read-block#s file-len @ alloc-mem
        !           115:   0 0 seek ABORT" ext2-files read-dir: seek failed"
        !           116:   dup file-len @ read file-len @ <> ABORT" ext2-files read-dir: read failed" ;
        !           117: : .dir ( inode# -- )
        !           118:   read-dir dup BEGIN 2dup file-len @ - > over l@-le tuck and WHILE
        !           119:   cr dup 8 0.r space read-inode .inode space space dup .name
        !           120:   dup 4 + w@-le + REPEAT 2drop file-len @ free-mem ;
        !           121: : (find-file) ( adr name len -- inode#|0 )
        !           122:   2>r dup BEGIN 2dup file-len @ - > over l@-le and WHILE
        !           123:   dup 8 + over 6 + c@ 2r@ str= IF 2r> 2drop nip l@-le EXIT THEN
        !           124:   dup 4 + w@-le + REPEAT 2drop 2r> 2drop 0 ;
        !           125: : find-file ( inode# name len -- inode#|0 )
        !           126:   2>r read-dir dup 2r> (find-file) swap file-len @ free-mem ;
        !           127: : find-path ( inode# name len -- inode#|0 )
        !           128:   dup 0= IF 3drop 0 ."  empty name " EXIT THEN
        !           129:   over c@ [char] \ = IF 1 /string ."  slash " RECURSE EXIT THEN
        !           130:   [char] \ split 2>r find-file ?dup 0= IF
        !           131:   2r> 2drop false ."  not found " EXIT THEN
        !           132:   r@ 0<> IF 2r> ."  more... " RECURSE EXIT THEN
        !           133:   2r> 2drop ."  got it " ;
        !           134: : close ;
        !           135: : open
        !           136:   do-super
        !           137:   80 alloc-mem inode !
        !           138:   my-args nip 0= IF 0 0 ELSE
        !           139:   2 my-args find-path ?dup 0= IF close false EXIT THEN THEN
        !           140:   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.