home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / FFA.ZIP / SAVEEXE.SEQ < prev    next >
Encoding:
Text File  |  1988-01-02  |  9.2 KB  |  230 lines
  1. \ SAVEEXE.SEQ   A SAVE EXE routine. Extracted from F83Y by Tom Zimmer
  2.  
  3. only forth also hidden definitions also
  4.  
  5. \ Some code to allow saving the Forth system to disk in the .EXE format.
  6.  
  7. CODE XCKSUM ( add cnt startv seg - cksum )
  8.                 POP DS
  9.                 POP AX
  10.                 POP CX
  11.                 POP BX
  12.         HERE    ADD AX, 0 [BX]
  13.                 INC BX
  14.                 INC BX
  15.                 DEC CX
  16.         LOOP    PUSH CS
  17.                 POP DS
  18.                 1PUSH    END-CODE
  19.  
  20. HEX
  21.  
  22. CREATE SUVEC  100 , 0 ,
  23. VARIABLE DPSTART                        \ A place to save DP for restoral
  24.  
  25. LABEL  SEXE
  26.         MOV SUVEC 2+ DS                 \ Save DS ins setup vector
  27.         MOV AX, DS                      \ move DS to AX
  28.         ADD AX, # #CODESEGS #LISTSEGS + \ Add 128K to get to heads
  29.         MOV ES, AX                      \ move head seg to ES
  30.         MOV BX, UP                      \ Move UP to BX
  31.         MOV CX, ' YDP >body @ [BX]      \ get contents of YDP user variable
  32.         MOV SI, CX                      \ move it into SI
  33.         DEC SI
  34.         MOV DI, SI                      \ decrement SI and move to DI
  35.         XOR AX, AX                      \ Clear AX
  36.         XCHG AX, YSTART                 \ Exchange AX, and YSTART clearing it
  37.         ADD AX, SUVEC 2+                \ Add to setup vector
  38.         PUSH DS                         \ save DS
  39.         MOV DS, AX                      \ move AX to DS
  40.         OR CX, CX 0<>                   \ if YDP was not zero (0)
  41.         IF      STD
  42.                 REPZ
  43.                 MOVSB                   \ move HEADS to head space
  44.                 CLD
  45.         THEN
  46.         POP DS                          \ restore DS
  47.         MOV YSEG ES                     \ set YSEG to ES
  48.         MOV AX, DS                      \ move DS to AX
  49.         ADD AX, # #CODESEGS             \ Add 64k to get to heads
  50.         MOV ES, AX                      \ move head seg to ES
  51.         MOV BX, UP                      \ Move UP to BX
  52.         MOV CX, ' XDP >body @ [BX]      \ get contents of XDP user variable
  53.         MOV SI, CX                      \ move it into SI
  54.         DEC SI
  55.         MOV DI, SI                      \ decrement SI and move to DI
  56.         MOV AX, XSTART                  \ mov XSTART to AX
  57.         ADD AX, SUVEC 2+                \ Add to setup vector
  58.         PUSH DS                         \ save DS
  59.         MOV DS, AX                      \ move AX to DS
  60.         OR CX, CX 0<>                   \ if XDP was not zero (0)
  61.         IF      STD
  62.                 REPZ
  63.                 MOVSB                   \ move LISTS to LIST space
  64.                 CLD
  65.         THEN
  66.         POP DS                          \ restore DS
  67.         MOV XSEG ES                     \ set XSEG to ES
  68.         MOV AX, DPSTART                 \ Move DPSTART
  69.         MOV XSTART AX                   \ into XSTART, for use setting DP
  70.         MOV XMOVED # -1 WORD            \ Initialize LIST to already moved.
  71.         JMP FAR [] SUVEC                \ Jump to forth cold entry.
  72.         END-CODE
  73.  
  74. \ An empty .EXE header table.
  75.  
  76. CREATE  EHMT
  77. ( +0)   5A4D ,          \ EHADR         .EXE File marker
  78. ( +2)   0 ,             \ EHLMRV        File mod 512 including header
  79. ( +4)   0 ,             \ EH512Z        Number of 512 byte blocks in file
  80. ( +6)   0 ,             \ Number of relocation table items
  81. ( +8)   2 ,             \ Size of header in segments
  82. ( +A)   0 ,             \ Minimum segments needed by program
  83. ( +C)   0FFFF ,         \ Additional segments needed by program, infinity
  84. ( +E)   0FFF0 ,         \ SS            Stack segment, 100h below code strt
  85. ( +10)  0FFFC ,         \ Offset for stack pointer.
  86. ( +12)  0 ,             \ Word chekcsum, adds up to -1
  87. ( +14)  SEXE ,          \ Offset to put in IP when passing control
  88. ( +16)  0FFF0 ,         \ CS            Code segment, 100h below code strt
  89. ( +18)  1C ,            \ Displacement in bytes to first relocation item
  90. ( +1A)  0 ,             \ Overlay #, or zero (0) for resident code
  91.  
  92. ( +1C)  0 ,             \ Null relocation item, and fill to two (2) segments
  93. ( +1E)  0 ,
  94.  
  95. DECIMAL
  96.  
  97. comment:
  98.  
  99. XCKSUM  checksums a block of memory using word addition ( cnt must be even )
  100.  
  101. SUVEC  startup vector, for a long jump to HEX 100 to set up
  102.    CS correctly.  Currently the .EXE header has CS set at
  103.    0FFF0h which fakes out the loader to set CS to the same
  104.    as the Program Sement Prefix.  This makes the long jump
  105.    unnecessary, but we put it in so we could easily make
  106.    the .EXE header more conventional.
  107.  
  108. SEXE  entry point specified by .EXE header.  Sets the seg part
  109.    of SUVEC, moves FORTH headers up to seg after DS (YSEG),
  110.    does long jump thru SUVEC to start system.
  111.  
  112. EHMT  empty .EXE header.  Entries 0Eh and 16h are SS and CS,
  113.    set to -10h, somewhat questionable.  If they are changed,
  114.    10h and 14h must be changed to compensate.
  115.  
  116. comment;
  117.  
  118.  
  119. HEX
  120.   20        CONSTANT EHZ
  121.  100 EHZ -  CONSTANT EHADR
  122.  EHADR 2+   CONSTANT EHLMRV
  123.  EHADR 4 +  CONSTANT EH512Z
  124.  EHADR 12 + CONSTANT EHCKSM
  125.  EHADR 10 + CONSTANT EHSP
  126.  
  127. comment:
  128.  
  129.         Constants for EXE header.  Header is put immediately before
  130.         100h for write-out.  See DOS 2.0 appendix H for explanation.
  131.  
  132.         EHADR   header address
  133.         EHZ     header size
  134.         EHLMRV  load module remainder
  135.         EH512Z  # 512 blocks in entire file
  136.         EHCKSM  entire file checksum so file words total to FFFFh
  137.         EHSP    startup SP
  138.  
  139. comment;
  140.  
  141. HEX
  142.  
  143. : WEXE  ( handle --- )
  144.      >R                                 \ Save the file HANDLE
  145.         HERE DPSTART !                  \ Save DP for later restoral
  146.         EHMT EHADR EHZ CMOVE            \ Move empty header to before 100H
  147.         HERE 20 + EHSP !                \ Startup Stack Pointer to HERE+20H
  148.         HERE 05F + U2/ 8 / XSTART !     \ Save start segment in XSTART
  149.         XDP @ 1F + U2/ 8 /              \ Calculate LIST length in segments
  150.         XSTART @ +                      \ add LIST start segment
  151.         YSTART !                        \ Save start segment in YSTART
  152.         YDP @ 1F + U2/ 8 /              \ HEAD length in segments
  153.         YSTART @ +                      \ = total length in segments
  154.         EHADR U2/ 8 / -                 \ Subtract Header segments
  155.         DUP 20 MOD                      \ Remainder of 512 byte pages
  156.         10 * EHLMRV !                   \ save BYTE remainder in EHLMRV
  157.         1F + U2/ 10 / EH512Z !          \ Set # of full pages into EH512Z
  158.  
  159.         0 YDP @ 1F + 0FFF0 AND          \ HEAD length in bytes
  160.         0 YSEG @ XCKSUM                 \ Checksum HEADS
  161.         0 XDP @ 1F + 0FFF0 AND          \ LIST length in bytes
  162.         ROT XSEG @ XCKSUM               \ Checksum LIST
  163.         EHADR HERE 05F + 0FFF0 AND      \ CODE length in bytes
  164.         EHADR - ROT ?CS: XCKSUM         \ Checksum CODE
  165.         NOT EHCKSM +!                   \ Save checksum in EHCKSM
  166.  
  167.         EHADR                           \ Start address
  168.         HERE 05F + 0FFF0 AND            \ end address is total length
  169.         EHADR - \ dup u.                  \ subtract space below header
  170.      R@ HWRITE DROP                     \ Write CODE space
  171.  
  172.         0                               \ From segment offset 0
  173.         XDP @ 1F + 0FFF0 AND \ dup u.     \ LIST length in bytes
  174.      R@ XSEG @ EXHWRITE DROP            \ Write LIST space
  175.  
  176.         0                               \ From segment offseg 0
  177.         YDP @ 1F + 0FFF0 AND \ dup u.     \ HEAD length in bytes
  178.      R> YSEG @ EXHWRITE DROP            \ Write HEAD space
  179.         YSTART OFF ;                    \ Reset YSTART
  180.  
  181. DECIMAL
  182.  
  183. only forth definitions also hidden also
  184.  
  185. handle exehcb
  186. variable ?gotov         \ Do we have anything to save?
  187. defer append-ov         \ A defered word to append an overlay to saved EXE.
  188.  
  189. : *save-exe     ( | name --- )
  190.                 exehcb !hcb " EXE" ">$
  191.                 exehcb $>ext
  192.                 exehcb hcreate abort" Could not create file"
  193.                 exehcb wexe
  194.                 ?gotov @
  195.                 if      append-ov
  196.                 then
  197.                 exehcb hclose drop ;
  198.  
  199. : save-exe      ( | name --- )
  200.                 DECIMAL                 \ Save system in DECIMAL number base
  201.                 >in @ span @ 1- >
  202.                 if      cr ." File to save? " query
  203.                 then    ?gotov @
  204.                 if      >in @ >r
  205.                         *save-exe
  206.                         r> >in !
  207.                 then    *save-exe ;
  208.  
  209. ' save-exe alias FSAVE ( | name --- )    \ a pseudonym for SAVE-EXE
  210.  
  211. comment:
  212.  
  213. WEXE    ( fcb ) write .EXE file given FCB of opened file.
  214.         Copies header from EHMT to below 100h, fills out EHSP,
  215.         EHMLRV, EH512Z, sets DTA, computes YSEG (headers) checksum,
  216.         plus checksum from 0E0h to YSTART, puts NOT in EHCKSM,
  217.         writes 0E0h to YSTART, then sets DTA for YSEG, writes
  218.         out FORTH headers.  "lobz" is the size of the first write,
  219.         0E0h to YSTART.  Image is written with YSTART containing
  220.         offset where the header segment data begins.  YSTART non-
  221.         zero indicates the segment hasn't been moved to its correct
  222.         location for running.
  223.  
  224. SAVE-EXE  like SAVE-SYSTEM, but makes a .EXE file.
  225.  
  226. comment;
  227.  
  228. only forth definitions also
  229.  
  230.