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

   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
  13
  14 \ package which adds support to read the romfs
  15 \ this package is somehow limited as the maximum supported length
  16 \ for a file name is hardcoded to 0x100
  17
  18 s" rom-files" device-name
  19
  20 INSTANCE VARIABLE length
  21 INSTANCE VARIABLE next-file
  22 INSTANCE VARIABLE buffer
  23 INSTANCE VARIABLE buffer-size
  24 INSTANCE VARIABLE file
  25 INSTANCE VARIABLE file-size
  26 INSTANCE VARIABLE found
  27
  28 : open  true
  29   100 dup buffer-size ! alloc-mem buffer ! false found ! ;
  30 : close buffer @ buffer-size @ free-mem ;
  31
  32 : read ( addr len -- actual ) s" read" $call-parent ;
  33
  34 : seek ( lo hi -- status ) s" seek" $call-parent ;
  35
  36 : .read-file-name ( offset -- str len )
  37   \ move to the file name offset
  38   0 seek drop
  39   \ read <buffer-size> bytes from that address
  40   buffer @ buffer-size @ read drop
  41   \ write a 0 to make sure it is a 0 terminated string
  42   buffer-size @ 1 - buffer @ + 0 swap c!
  43   buffer @ zcount ;
  44
  45 : .print-info ( offset -- )
  46   dup 2 spaces 6 0.r 2 spaces dup
  47   8 + 0 seek drop length 8 read drop
  48   6 length @ swap 0.r 2 spaces
  49   20 + .read-file-name type cr ;
  50
  51 : .list-header cr
  52   s" --offset---size-----file-name----" type cr ;
  53
  54 : list
  55   .list-header
  56   0 0 BEGIN + dup
  57   .print-info dup 0 seek drop
  58   next-file 8 read drop next-file @
  59   dup 0= UNTIL 2drop ;
  60
  61 : (find-file)  ( name len -- offset | -1 )
  62    0 0 seek drop false found !
  63    file-size ! file ! 0 0 BEGIN + dup
  64    20 + .read-file-name file @ file-size @
  65    str= IF true found ! THEN
  66    dup 0 seek drop
  67    next-file 8 read drop next-file @
  68    dup 0= found @ or UNTIL drop found @ 0=
  69    IF drop -1 THEN ;
  70
  71 : load  ( addr -- size )
  72    my-parent instance>args 2@ [char] \ left-parse-string 2drop
  73    (find-file) dup -1 = IF 2drop 0 ELSE
  74       \ got to the beginning
  75       0 0 seek drop
  76       \ read the file size
  77       dup 8 + 0 seek drop
  78       here 8 read drop here @  ( dest-addr offset file-size )
  79       \ read data start offset
  80       over 18 + 0 seek drop
  81       here 8 read drop here @  ( dest-addr offset file-size data-offset )
  82       rot + 0 seek drop  ( dest-addr file-size )
  83       read
  84    THEN
  85 ;