home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / FFA.ZIP / SAVESYS.SEQ < prev    next >
Encoding:
Text File  |  1987-12-27  |  2.9 KB  |  74 lines
  1. \ SAVESYS.SEQ   SAVE-SYSTEM and TURNKEY                 by Tom Zimmer
  2.  
  3. .comment:
  4.  
  5.  
  6.  
  7.   This file allows saving the Forth memory image as a .COM file. This
  8. .COM file can include the Forth HEADs, or they may optionally be omitted.
  9. The word SAVE-SYSTEM will save Forth with HEADs. The word TURNKEY used
  10. in the following manner:
  11.  
  12.                 ' MYAPPLICATION TURNKEY MYAPP.COM <enter>
  13.  
  14.   This will create a .COM file on disk which contains ONLY the Forth code
  15. up to HERE, without HEADs. The .COM file will automatically execute the
  16. word MYAPPLICATION after cold start initialization. This results in a
  17. pseudo minimized Forth application. The program can be made smaller by
  18. omitting many of the Forth utilities loaded in the file SDF.SEQ.
  19.  
  20. comment;
  21.  
  22. ONLY FORTH ALSO DEFINITIONS
  23.  
  24. : SAVE          ( Addr len filename --- )
  25.                 SHNDL+ !HCB
  26.                 SHNDL+ HDELETE   DROP
  27.                 SHNDL+ HCREATE   ABORT" Save Create ERR!"
  28.                 SHNDL+ HWRITE 0= ABORT" Save Write  ERR!"
  29.                 SHNDL+ HCLOSE    ABORT" Save Close  ERR!" ;
  30.  
  31. : SAVE-SYSTEM   ( -- )
  32.                 HERE 0 XHERE 0 D+ YHERE 0 D+ 20. D+ SP@ 0 D>
  33.                 ABORT" Too big. Use FSAVE."
  34.                 HERE XSTART ! 0 XS: ?CS: HERE XHERE DUP ALLOT CMOVEL
  35.                 HERE YSTART ! 0 YS: ?CS: HERE YHERE DUP ALLOT CMOVEL
  36.                 XMOVED OFF
  37.                 256 HERE SAVE
  38.                 XSTART @ DP !
  39.                 YSTART OFF
  40.                 XMOVED ON ;
  41.  
  42. DEFER TBOOT     ' NOOP IS TBOOT         \ Turnkey BOOT
  43.  
  44. : TSETSEGS      ( --- )
  45.                 DOSVER 2 < ABORT" Must have DOS 2 or higher."
  46.                 #CODESEGS #LISTSEGS +
  47.                 MEMSET MEMCHK         \ Allocate proper memory
  48.                 YSEG OFF                        \ No heads
  49.                 ?ES: XSEG !
  50.                 ?CS: DUP SSEG ! VTSEG !         \ Set segments
  51.                 XSTART @ DP !                   \ Reset DP
  52.                 #OUT 0! 24 #LINE ! ;            \ set #OUT and #LINE
  53.  
  54. : TSTART        ( --- )
  55.                 SP0 @ 'TIB ! >IN OFF SPAN OFF #TIB OFF LOADING OFF
  56.                 DEFAULT TBOOT BYE ;
  57.  
  58. : TURNKEY       ( A1 | name.COM --- )   \ A! is CFA of BOOT function
  59.                 HERE 0 XHERE 0 D+ 20. D+ SP@ 0 D>
  60.                 ABORT" Too big. Use FSAVE."
  61.                 1 ?ENOUGH                       \ Assure enough params
  62.                              IS TBOOT           \ Save into TBOOT
  63.                 ['] TSETSEGS IS SEGSET          \ Set segments
  64.                 ['] TSTART   IS BOOT            \ TSTART is BOOT
  65.                 HERE XSTART ! 0 XS: ?CS: HERE XHERE DUP ALLOT CMOVEL
  66.                 YSTART OFF
  67.                 XMOVED OFF
  68.                 256 HERE SAVE           \ Save the code space
  69.                 XSTART @ DP !           \ Reset DP
  70.                 YSTART OFF              \ Clear Head flag
  71.                 XMOVED ON ;
  72.  
  73.  
  74.