home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / binsave.seq < prev    next >
Encoding:
Text File  |  1990-12-17  |  2.0 KB  |  47 lines
  1. \ BINSAVE.SEQ           Save Target Binary Image        by Andrew McKewan
  2.  
  3. ONLY FORTH ALSO DEFINITIONS COMPILER ALSO
  4.  
  5. : ?cerrors      ( -- f1 )
  6.                 cerrors dup
  7.         if      cr ." \3 Image not saved \2 COMPILE ERRORS! "
  8.                 cr here-t code-start - 5 .r ."  Bytes compiled" cr
  9.         then    ;
  10.  
  11. : save-image.bin ( -- )
  12.                 ?cerrors ?exit
  13.                 #unres
  14.         if      cr ." \3 Image not saved \0, some symbols \2 UNRESOLVED! "
  15.                 cr here-t code-start - 5 .r ."  Bytes compiled"
  16.         else    image.name targethndl $>handle
  17.                 " BIN" ">$ targethndl $>ext
  18.                 targethndl hcreate                      \ make image.com
  19.                 if      0 " Error while creating object file." "errmsg2
  20.                         abort
  21.                 then
  22.                 cr cr ." Created object file - " targethndl count type
  23. \                data-seg-fix                    \ adjust HERE-T and fix
  24. \                                                \ DATA segment alignment
  25. \                dp-set                          \ set targets DP
  26. \                code-start here-t over - dup>r
  27.                 0 $2000 dup>r  ( always write 8K )
  28.                 targethndl seg-code exhwrite r> -       \ write CODE
  29.                 if      0 " Error while saving CODE to object file."
  30.                         "errmsg2 abort
  31.                 then
  32.                 cr ." Wrote " here-t code-start - ( dup>r ) 5 u.r
  33.                 ."  Bytes of CODE." \  rounded up to Paragraph."
  34. \                data-origin here-d
  35. \                targethndl seg-code exhwrite here-d -
  36. \                if      0 " Error while saving DATA to executable file."
  37. \                        "errmsg2 abort
  38. \                then
  39. \                cr ." Wrote " here-d data-start - 5 u.r ."  Bytes of DATA, "
  40. \                here-d r> + 5 u.r ."  Bytes total.
  41.         then    cr ;
  42.  
  43. ' SAVE-IMAGE.BIN IS SAVE-IMAGE.COM
  44.  
  45.  
  46.  
  47.