Annotation of gforth/fi2c.fs, revision 1.1

1.1     ! pazsan      1: \ Convert image to C include file
        !             2: 
        !             3: 0 Value image
        !             4: 0 Value bitmap
        !             5: 
        !             6: Create magicbuf 8 allot
        !             7: 
        !             8: : search-magic ( fd -- )  >r
        !             9:     BEGIN  magicbuf 8 r@ read-file throw  8 =  WHILE
        !            10:        magicbuf s" Gforth1" tuck compare 0=  UNTIL
        !            11:     ELSE  true abort" No magic found"  THEN
        !            12:     rdrop ;
        !            13: 
        !            14: Create image-header  4 cells allot
        !            15: Variable image-cells
        !            16: Variable bitmap-chars
        !            17: 
        !            18: : read-header ( fd -- )
        !            19:     image-header 4 cells rot read-file throw drop
        !            20:     image-header 2 cells + @ dup cell / image-cells ! 1- 8 cells / 1+ bitmap-chars !
        !            21:     image-cells @ cells allocate throw to image
        !            22:     bitmap-chars @ allocate throw to bitmap ;
        !            23: 
        !            24: : read-dictionary ( fd -- )  >r
        !            25:     image image-cells @ cells r> read-file throw drop ;
        !            26: 
        !            27: : read-bitmap ( fd -- )  >r
        !            28:     bitmap bitmap-chars @ r> read-file throw drop ;
        !            29: 
        !            30: : .08x ( n -- ) 0 <# # # # # # # # # 'x hold '0 hold #> type ;
        !            31: : .02x ( n -- ) 0 <# # # 'x hold '0 hold #> type ;
        !            32: 
        !            33: : .image ( -- )
        !            34:     image-cells @ 0 ?DO
        !            35:        I 4 + I' min I ?DO  space image I cells + @ .08x ." ," LOOP cr
        !            36:        4 +LOOP ;
        !            37: 
        !            38: : .reloc ( -- )
        !            39:     bitmap-chars @ 0 ?DO
        !            40:        I 8 + I' min I ?DO  space bitmap I + c@ .02x ." ," LOOP cr
        !            41:        8 +LOOP ;
        !            42: 
        !            43: : read-image ( addr u -- )
        !            44:     r/o bin open-file throw >r
        !            45:     r@ search-magic
        !            46:     r@ file-position throw r@ read-header r@ reposition-file throw
        !            47:     r@ read-dictionary r@ read-bitmap r> close-file throw ;
        !            48: 
        !            49: : .imagesize ( -- )
        !            50:     image-header 3 cells + @ 1 cells / .08x ;
        !            51: 
        !            52: : .relocsize ( -- )
        !            53:     bitmap-chars @ .08x ;
        !            54: 
        !            55: : fi2c ( addr u -- )  base @ >r hex
        !            56:     read-image
        !            57:     ." #include " '" emit ." forth.h" '" emit cr
        !            58:     ." Cell image[" .imagesize ." ] = {" cr .image ." };" cr
        !            59:     ." const char reloc_bits[" .relocsize ." ] = {" cr .reloc ." };" cr
        !            60:     r> base ! ;
        !            61: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>