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>