qemu/roms/SLOF/slof/fs/packages/ext2-files.fs

   1 \ *****************************************************************************
   2 \ * Copyright (c) 2004, 2011 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 inode-size
  16 INSTANCE VARIABLE block-size
  17 INSTANCE VARIABLE inodes/group
  18
  19 INSTANCE VARIABLE group-desc-size
  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
  27 INSTANCE VARIABLE indirect-block
  28 INSTANCE VARIABLE dindirect-block
  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 ;
  51
  52 : read-double-indirect-blocks ( double-indirect-block# -- )
  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
  62 ;
  63
  64 : read-triple-indirect-blocks ( triple-indirect-block# -- )
  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
  74 ;
  75
  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
  90   swap inode-size @ * + xlsplit seek drop  inode @ inode-size @ read drop
  91 ;
  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 !
 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 ;
 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 " ;
 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
 182 : open
 183   0 data ! 0 blocks ! 0 #blocks !
 184   do-super
 185   inode-size @ alloc-mem inode !
 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= ;