Return to fi2c.fs CVS log

Up to [gforth] / gforth

Bug fix: print cause for problems in command line
Cleaned up Makefiles
Adjusted configures for DOS and OS/2 (not tested yet)
New feature: link image into executable (for non-OS systems)

    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: