Return to rom-files.fs CVS log

Up to [Qemu by Fabrice Bellard] / qemu / roms / SLOF / slof / fs / packages

Annotation of qemu/roms/SLOF/slof/fs/packages/rom-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: 
        !            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: ;

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