home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / overlay.seq < prev    next >
Text File  |  1991-02-25  |  9KB  |  204 lines
  1. \\ OVERLAY.SEQ        Overlay mechanism for F-PC         by Tom Zimmer
  2.  
  3.   This file contains the code needed to allow defining overlays for F-PC.
  4.  
  5.   This tool allows the definition of specific entrypoints into an overlay,
  6. and as such is best used for modules that have only a few entry points.
  7. Other words in an overlay are not accessible after the overlay has been
  8. defined. each overlay must be given an unique name of eight characters
  9. or less, using STARTOV. The overlay is then saved to the specified name
  10. with a .OVL file extension. Version verification is performed each time
  11. an overlay is loaded, to assure an incompatible overlay is not accidently
  12. loaded and used.
  13.  
  14. !! WARNING !!      !!! One overlay MAY NOT CALL ANOTHER OVERLAY !!!
  15.  
  16. ***************************************************************************
  17.  
  18.   Used as follows:
  19.  
  20.         STARTOV myovfilename                    \ starts an overlay
  21.  
  22.                 load the overlay contents       \ defines some new words
  23.  
  24.         ENDOV                                   \ ends overlay definition
  25.  
  26.                 ENTRYPOINT wordname1            \ makes somw words from
  27.                 ENTRYPOINT wordname2            \ overlay available to world
  28.  
  29.         CLEAROV                                 \ clear the overlay from mem
  30.  
  31.         wordname1                       \ when used, causes overlay to be
  32.                                         \ loaded, then wordname1 executed
  33.  
  34.   The defered word ?OVERROR can be changed by a user application to send
  35. the user an error message in a particular way if needed. Any error
  36. encountered while trying to read in an overlay file at runtime, will
  37. terminate the overlay entrypoint word, and set the ?OVFLAG word FALSE.
  38. This allows the application to clean up the stack parameters that would
  39. have been used by the overlay entrypoint word if it had run.
  40.  
  41.                 ***** Before Creating an Overlay *****
  42.  
  43.   This file must of course be loaded on F-PC 3.54 of higher, then the
  44. system must be saved to a new .EXE file then restarted.  F-PC defaults the
  45. system VALUEs #OVSEGS and #OVBYTES to zero when extending F-PC, so these
  46. values must be set to something other than zero (F-PC must then be resaved)
  47. for the overlay mechanism to work. When this file is loaded, they will be
  48. given default values of 4k each by a conditional sequence at the end of
  49. this file.
  50.  
  51. {
  52.  
  53. \       ************************************************************
  54. \       Test for overlay mechanism already loaded, leave if it has.
  55. \+ ovhndl       cr .( Overlay utility already loaded ) \S
  56. \       ************************************************************
  57.  
  58. hidden also
  59.  
  60. handle ovhndl
  61. 0 value ?ov             \ is an overlay currently active?
  62. 0 value ovname          \ name pointer for overlay currently being defined
  63. 0 value xdpsave         \ a place to save some dictionary pointers
  64. 0 value xdpsegsave
  65. 0 value dpsave
  66. 0 value ?stacksave      \ a place to save the ?STACK function
  67. 0 value ?ovflag         \ a flag for an application to look at to check if
  68.                         \ the most recent overlay word it executed worked
  69.                         \ properly. Will contain FALSE if an error occured
  70.                         \ while trying to read in the overlay file.
  71.  
  72. gettime 2constant ovstamp
  73.  
  74. defer ?overror          \ defered for easy application control
  75.  
  76. : %?overror     ( f1 a1 n1 -- f1 )      \ error test for overlay
  77.                 rot
  78.                 if      cr type true
  79.                 else    2drop   false
  80.                 then    ;
  81.  
  82. ' %?overror is ?overror         \ install error handler
  83.  
  84. : startofov     ( -- a1 )       \ start of overlay in CODE space
  85.                 #ovbytes negate $10 - ;
  86.  
  87. : startofovseg  ( -- seg )      \ start of overlay in LIST space
  88.                 #ovsegs negate +xseg ;
  89.  
  90. : ?stackov      ( -- )          \ ?STACK while defining an overlay
  91.                 dp @ 80 negate u> if stackover then ;
  92.  
  93. : startov       ( | ovname -- ) \ start defining a new overlay
  94.                 #ovsegs 0= abort" No space available for an overlay"
  95.                 ?ov abort" An overlay is already active"
  96.                 startofov #ovbytes 0 fill
  97.                 startofovseg 0 #ovsegs 16 * 0 lfill
  98.                 off> ovname                     \ clear overlay filename
  99.                 bl word ovhndl $>handle         \ move name to overlay handle
  100.                 " OVL" ">$ ovhndl $>ext         \ change file extension
  101.                 ovhndl hcreate abort" Could not create overlay file"
  102.                 @> ?stack =: ?stacksave ['] ?stackov is ?stack
  103.                 xhere paragraph + =: xdpsave here =: dpsave
  104.                 startofovseg xdpseg ! xdp off
  105.                 startofov dp !
  106.                 ovstamp , ,
  107.                 _headerless
  108.                 on> ?ov ;
  109.  
  110.  
  111. : endov         ( -- )          \ finish the definition of a new overlay
  112.                 ?ov 0= abort" No overlay currently being defined"
  113.                 startofov #ovbytes ovhndl hwrite drop           \ write CODE
  114.                 0 #ovsegs 16 * ovhndl
  115.                 startofovseg exhwrite drop              \ write LIST
  116.                 _headers
  117.                 xdpsave xdpseg ! xdp off dpsave dp !
  118.                 ?stacksave is ?stack                    \ restore stack check
  119.                 here =: ovname
  120.                 gettime nip ,
  121.                 ovhndl count here place
  122.                 here c@ 1+ allot
  123.                 ovhndl hclose drop ;
  124.  
  125. : clearov       ( -- )                  \ clear unneded symbols from memory
  126.                 ?ov 0= ?exit
  127.                 ovname 0= if endov then
  128.                 _behead
  129.                 off> ?ov ;
  130.  
  131.  
  132. : clearov_init  ( -- )
  133.                 defers initstuff
  134.                 clearov ;
  135.  
  136. ' clearov_init is initstuff             \ install in initialization chain
  137.  
  138. : ?loadov       ( a1 -- a1 f1 )
  139.                 dup @ @ ?ov = dup ?exit drop    \ leave if ID is OK
  140.                 off> ?ovflag                    \ clear overlay error flag
  141.                 #ovsegs 0=
  142.                 " No room for overlay file"    ?overror if false exit then
  143.                 dup @ 2+ ovhndl $>handle
  144.                 ovhndl hopen
  145.                 " Couldn't open overlay file." ?overror if false exit then
  146.                 startofov #ovbytes ovhndl hread #ovbytes <>
  147.                 0 #ovsegs 16 * ovhndl
  148.                 startofovseg exhread #ovsegs 16 * <> or
  149.                 " Error in overlay read."      ?overror if false exit then
  150.                 startofov 2@ ovstamp d= 0=
  151.                 " Incompatible overlay"        ?overror if false exit then
  152.                 dup @ @ =: ?ov
  153.                 ovhndl hclose drop true
  154.                 on> ?ovflag ;
  155.  
  156. : entrypoint    ( | name -- )
  157.                 h-state 2 <> abort" Must do ENDOV first"
  158.                 >in @ ' swap >in !
  159.                 false save!> warning
  160.                 create ovname , ,
  161.                 restore> warning
  162.                 does> ?loadov if 2+ perform else drop then ;
  163.  
  164. previous
  165.  
  166. \ **********************************************************************
  167. \ ***** Give us some overlay room if we haven't already taken some *****
  168. \ **********************************************************************
  169.  
  170. #ovsegs 0=                              \ if no overlay space, make some
  171. #if     $00100 =: #ovsegs               \ 4k for LIST and
  172.         $01000 =: #ovbytes              \ 4k for CODE
  173.         cr
  174.         cr .( You must do an "FSAVE <filename>" and then restart with )
  175.         cr .( the new .EXE file before trying to create an overlay.)
  176.         cr
  177. #endif
  178.  
  179. \S ***********************************************************************
  180.  
  181. \               ******************************
  182. \               A simple example of an overlay
  183. \               ******************************
  184.  
  185.  
  186. \ Start loading at about this line to define a sample overlay file.
  187.  
  188.         STARTOV MYOVTEST                        \ starts an overlay
  189.  
  190.                 : OV1   ." First "   ;
  191.                 : OV2   ." Second "  ov1 ;
  192.                 : OV3   ." Third "   ov2 ;
  193.                 : OV4   ." Fourth "  ov3 ;
  194.                 : OV5   ." Fifth "   ov4 ;
  195.  
  196.         ENDOV                                   \ ends overlay definition
  197.  
  198.                 ENTRYPOINT OV2                  \ makes some words from
  199.                 ENTRYPOINT OV5                  \ overlay available to world
  200.  
  201.         CLEAROV                                 \ clear the overlay from mem
  202.  
  203.  
  204.