home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / saveexe.seq < prev    next >
Text File  |  1990-07-23  |  7KB  |  188 lines
  1. \ SAVEEXE.SEQ   A SAVE EXE routine. Extracted from F83Y by Tom Zimmer
  2.  
  3. headerless
  4.  
  5. \ An empty .EXE header table.
  6.  
  7. CREATE  EHMT
  8. ( +0)   $5A4D ,         \ EHADR         .EXE File marker
  9. ( +2)   $00 ,           \ EHLMRV        File mod 512 including header
  10. ( +4)   $00 ,           \ EH512Z        Number of 512 byte blocks in file
  11. ( +6)   $00 ,           \ Number of relocation table items
  12. ( +8)   $02 ,           \ Size of header in segments
  13. ( +A)   $00 ,           \ Minimum segments needed by program
  14. ( +C)   $0FFFF ,        \ Additional segments needed by program, infinity
  15. ( +E)   $0FFF0 ,        \ SS            Stack segment, 100h below code strt
  16. ( +10)  $0FFFC ,        \ Offset for stack pointer.
  17. ( +12)  $00 ,           \ Word chekcsum, adds up to -1 ( DOS doesn't care! )
  18. ( +14)  SEXE ,          \ Offset to put in IP when passing control
  19. ( +16)  $0FFF0 ,        \ CS            Code segment, 100h below code strt
  20. ( +18)  $1C ,           \ Displacement in bytes to first relocation item
  21. ( +1A)  $00 ,           \ Overlay #, or zero (0) for resident code
  22.  
  23. ( +1C)  $00 ,           \ Null relocation item, and fill to two (2) segments
  24. ( +1E)  $00 ,
  25.  
  26. comment:
  27.  
  28. XCKSUM  checksums a block of memory using word addition ( cnt must be even )
  29.  
  30. SUVEC  startup vector, for a long jump to HEX 100 to set up
  31.    CS correctly.  Currently the .EXE header has CS set at
  32.    0FFF0h which fakes out the loader to set CS to the same
  33.    as the Program Sement Prefix.  This makes the long jump
  34.    unnecessary, but we put it in so we could easily make
  35.    the .EXE header more conventional.
  36.  
  37. SEXE  entry point specified by .EXE header.  Sets the seg part
  38.    of SUVEC, moves FORTH headers up to seg after DS (YSEG),
  39.    does long jump thru SUVEC to start system.
  40.  
  41. EHMT  empty .EXE header.  Entries 0Eh and 16h are SS and CS,
  42.    set to -10h, somewhat questionable.  If they are changed,
  43.    10h and 14h must be changed to compensate.
  44.  
  45. comment;
  46.  
  47.   $20        CONSTANT EHZ
  48.  $100 EHZ -  CONSTANT EHADR
  49.  EHADR   2+  CONSTANT EHLMRV
  50.  EHADR   4 + CONSTANT EH512Z
  51.  EHADR $12 + CONSTANT EHCKSM
  52.  EHADR $10 + CONSTANT EHSP
  53.  
  54. comment:
  55.  
  56.         Constants for EXE header.  Header is put immediately before
  57.         100h for write-out.  See DOS 2.0 appendix H for explanation.
  58.  
  59.         EHADR   header address
  60.         EHZ     header size
  61.         EHLMRV  load module remainder
  62.         EH512Z  # 512 blocks in entire file
  63.         EHCKSM  entire file checksum so file words total to FFFFh
  64.         EHSP    startup SP
  65.  
  66. comment;
  67.  
  68. VARIABLE SAVEERR        \ Did an error occur while writting
  69.  
  70. HEX
  71.  
  72. : WRITE-EXE ( handle --- bool )         \ bool = TRUE on ERROR while writting
  73.      >R                                 \ Save the file HANDLE
  74.         XHERE PARAGRAPH + XDPSEG !      \ Round up to next even paragraph
  75.         XDP OFF                         \ boundry, and reset XDP.
  76.         HERE DPSAVED !                  \ Save DP for later restoral
  77.         EHMT EHADR EHZ CMOVE            \ Move empty header to before 100H
  78.         HERE 100 + EHSP !               \ Startup Stack Pointer to HERE+20H
  79.         HERE 100 +
  80.         05F + U2/ 8 / DPSTART !    \ Save start segment in DPSTART
  81.         XDPSEG @ XSEG @ -               \ Calculate LIST length in segments
  82.         DUP XDPSEGLEN !                 \ LIST dictionary segment offset
  83.         DPSTART @ +                     \ add LIST start segment
  84.         YSTART !                        \ Save start segment in YSTART
  85.         WITHHEADS @
  86. IF      YDP @ 1F + U2/ 8 /              \ HEAD length in segments
  87. ELSE    0
  88. THEN    YSTART @ +                      \ = total length in segments
  89.         EHADR U2/ 8 / -                 \ Subtract Header segments
  90.         DUP 20 MOD                      \ Remainder of 512 byte pages
  91.         10 * EHLMRV !                   \ save BYTE remainder in EHLMRV
  92.         1F + U2/ 10 / EH512Z !          \ Set # of full pages into EH512Z
  93.  
  94.         0 EHCKSM !              \ dummy fill checksum value with a NULL
  95.  
  96.      R> YDP @ >R >R
  97.         WITHHEADS @ 0=
  98. IF      YSTART OFF
  99.         YDP OFF
  100. THEN
  101.  
  102.         EHADR                           \ Start address
  103.         HERE 100 +
  104.         05F + 0FFF0 AND            \ end address is total length
  105.         EHADR -                         \ subtract space below header
  106.         dup negate SAVEERR !
  107.      R@ HWRITE                          \ Write CODE space
  108.         saveerr +!
  109.  
  110.      R@ XDPSEG @ XSEG @ - 100 /MOD      \ Calc # of 4k byte sectors
  111.         SWAP >R dup>r 0                \ 100 hex * 16 decimal = 4096 decimal
  112.         ?DO     DUP 0 1000 ROT I 100 * +XSEG
  113.                 EXHWRITE 1000 - saveerr +!
  114.         LOOP    R> 0 R> 10 * dup negate saveerr +!
  115.                 2SWAP
  116.                 100 * +XSEG
  117.                 EXHWRITE saveerr +!
  118.  
  119.         WITHHEADS @
  120. IF      0                               \ From segment offseg 0
  121.         YDP @ 1F + 0FFF0 AND            \ HEAD length in bytes
  122.         dup negate saveerr +!
  123.      R> YSEG @ EXHWRITE                 \ Write HEAD space
  124.         saveerr +!
  125. ELSE r>drop
  126. THEN R> YDP !
  127.         YSTART OFF                      \ Reset YSTART
  128.         SAVEERR @ ;
  129.  
  130. DECIMAL
  131.  
  132. headers
  133.  
  134. handle exehcb
  135.  
  136. : <save-exe>    ( | name --- )
  137.                 DECIMAL                 \ Save system in DECIMAL number base
  138.                 more? 0=
  139.                 if      cr ." File to save? " query
  140.                 then
  141.                 exehcb !hcb " EXE" ">$
  142.                 exehcb $>ext
  143.                 exehcb hcreate abort" Could not create file"
  144.                 0 save!> loading
  145.                 exehcb write-exe        ( -- f1 )
  146.                 exehcb hclose or        ( -- f1 )
  147.                 abort" Write ERROR, Disk probably FULL!"
  148.                 restore> loading ;
  149.  
  150. : save-exe      ( | name --- )
  151.                 withheads on
  152.                 <save-exe> ;
  153.  
  154. ' save-exe alias FSAVE ( | name --- )    \ a pseudonym for SAVE-EXE
  155.  
  156. : turnkey       ( | name --- )
  157.                 #ovbytes 0=     \ only re-adjust CODE if no overlays
  158.                 if      here paragraph
  159.                         4096 paragraph + #codesegs min =: #codesegs
  160.                 then
  161.                 xhere drop xseg @ - 100 + =: #listsegs
  162.                 off> #headsegs
  163.                 withheads off
  164.                 <save-exe>
  165.                 bye ;
  166.  
  167. behead
  168.  
  169. only forth definitions also
  170.  
  171. comment:
  172.  
  173. WEXE    ( HANDLE ) write .EXE file given HANDLE of opened file.
  174.         Copies header from EHMT to below 100h, fills out EHSP,
  175.         EHMLRV, EH512Z, sets DTA, computes YSEG (headers) checksum,
  176.         plus checksum from 0E0h to YSTART, puts NOT in EHCKSM,
  177.         writes 0E0h to YSTART, then sets DTA for YSEG, writes
  178.         out FORTH lists, and headers.  "lobz" is the size of the first
  179.         write, 0E0h to YSTART.  Image is written with YSTART containing
  180.         offset where the header segment data begins.  YSTART non-
  181.         zero indicates the segment hasn't been moved to its correct
  182.         location for running.
  183.  
  184. SAVE-EXE  like SAVE-SYSTEM, but makes a .EXE file.
  185.  
  186. comment;
  187.  
  188.