home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / FFA.ZIP / OVERLAY.SEQ < prev    next >
Encoding:
Text File  |  1988-01-11  |  4.7 KB  |  162 lines
  1. \ OVERLAY.SEQ   An overlay mechanism for assembler and editor.
  2.  
  3. defined ovdp nip #if
  4. .comment:
  5. The OVERLAY file has already been loaded.
  6. comment;
  7. \s
  8. #endif
  9.  
  10. .comment:
  11.  
  12.   An overlay memory scheme to allow things to be loaded and take up
  13. dictionary space only when needed.  This is normally used only for the
  14. assembler, and editor.
  15.  
  16. comment;
  17.  
  18. warning dup @ swap off
  19.  
  20. only forth also definitions hidden definitions also
  21.  
  22. 15 1024 *               constant xovlen
  23. 10 1024 *                constant ovlen
  24. #listsegs 16 *
  25. xovlen - 1024 -         constant xovstart
  26. sp@ ovlen - 1024 -      constant ovstart
  27.  
  28. variable ovdp           ovdp off
  29. variable xovdp
  30. variable dpsave
  31. variable xdpsave
  32. variable ovseg          ovseg off
  33. variable xovseg         xovseg off
  34. variable ovstat         ovstat off
  35. variable filelistsave
  36. 2variable ovoffset
  37.  
  38. forth definitions
  39.  
  40. : >overlay      ( --- )
  41.                 ovstat @ 0=
  42.         if      ovstat on
  43.                 dp @ dpsave !           ovdp @ dp !
  44.                 xdp @ xdpsave !         xovdp @ xdp !
  45.         then    ;
  46.  
  47. : overlay>      ( --- )
  48.                 ovstat @
  49.         if      ovstat off
  50.                 ?gotov on
  51.                 dp @ ovdp !             dpsave @ dp !
  52.                 xdp @ xovdp !           xdpsave @ xdp !
  53.         then    ;
  54.  
  55. hidden definitions
  56.  
  57. : ovinit        ( --- )
  58.                 ovdp @ 0=
  59.         if      xovstart xovdp !
  60.                  ovstart  ovdp !
  61.                 >overlay
  62.                 12345 , ctime 2@ , ,
  63.                 overlay>
  64.         then    ;
  65.  
  66. : mem>save      ( --- )
  67.                 ?cs: ovstart ovseg @ 0 ovlen cmovel
  68.                 xovstart xs: xovseg @ 0 xovlen cmovel ;
  69.  
  70. : mem>ov        ( --- )
  71.                 ?cs: ovstart  ovseg @  ovlen  ovdp @  ovstart - cmovel
  72.                 xovstart xs: xovseg @ xovlen xovdp @ xovstart - cmovel ;
  73.  
  74. : save>mem      ( --- )
  75.                 ovseg  @ 0 ?cs: ovstart  ovlen cmovel
  76.                 xovseg @ 0 xovstart xs: xovlen cmovel ;
  77.  
  78. : ov>mem        ( --- )
  79.                 ovseg  @  ovlen ?cs: ovstart  ovdp @  ovstart - cmovel
  80.                 xovseg @ xovlen xovstart xs: xovdp @ xovstart - cmovel ;
  81.  
  82. : ?overlay      ( --- f1 )      \ Is the overlay already in memory good?
  83.                 ovseg @ ovlen     @l 12345 <>
  84.                 ovseg @ ovlen 2+  @l ctime @ <> or
  85.                 ovseg @ ovlen 4 + @l ctime 2+ @ <> or 0= ;
  86.  
  87. : ovsave        ( --- )
  88.                 ?overlay 0=
  89.         if      ."  No overlay to save. "
  90.         else    exehcb endfile ovoffset 2!
  91.                 ovlen  ovdp @ ovstart - dup >r exehcb ovseg @ exhwrite r> <>
  92.                 abort" Write Error in Overlay Code section"
  93.                 xovlen xovdp @ xovstart - dup >r
  94.                 exehcb xovseg @ exhwrite r> <>
  95.                 abort" Write Error on Overlay List section"
  96.         then    ;
  97.  
  98. : ?ovread       ( --- )
  99.                 ?overlay 0=
  100.         if      dosver 3 <
  101.                 if      " OVERLAY.BIN" ">$      \ if dos = 2.x, try this
  102.                         0.0 ovoffset 2!         \ and clear file offset
  103.                 else    me@ me$                 \ else read my own name
  104.                 then    shndl+ $>handle
  105.                 shndl+ hopen
  106.                 if      cr ." Could not open " shndl+ count type
  107.                         ."  to read Overlay." abort
  108.                 then
  109.                 ovoffset 2@ shndl+ movepointer
  110.                 ovlen  ovdp @ ovstart -  shndl+  ovseg @  exhread  drop
  111.                 ?overlay 0=
  112.                 if      cr ." Sorry, defective OVERLAY file."
  113.                         shndl+ hclose drop abort
  114.                 else
  115.                         xovlen xovdp @ xovstart - shndl+
  116.                         xovseg @ exhread drop
  117.                         shndl+ hclose drop
  118.                 then
  119.         then    ;
  120.  
  121. : ?ovalloc_err  ( n1 --- )
  122.                 8 = abort" Could not allocate overlay memory" ;
  123.  
  124. : ?ovalloc      ( --- )
  125.                 ovseg @ 0=
  126.                 if      ovlen 16 / 1+ 2* alloc ?ovalloc_err nip ovseg !
  127.                         xovlen 16 / 1+ 2* alloc ?ovalloc_err nip xovseg !
  128.                 then    ;
  129.  
  130. : cold_ovalloc  ( --- )
  131.                 defers initstuff
  132.                 ovseg off
  133.                 xovseg off ;
  134.  
  135. ' cold_ovalloc is initstuff
  136.  
  137. forth definitions
  138.  
  139. : ovon          ( --- )
  140.                 >overlay
  141.                 ?ovalloc
  142.                 ?ovread
  143.                 mem>save
  144.                 ov>mem ;
  145.  
  146. : ovoff         ( --- )
  147.                 overlay>
  148.                 mem>ov
  149.                 save>mem ;
  150.  
  151. : appendoverlay ( --- )
  152.                 ovon ovsave ovoff ;
  153.  
  154. ' appendoverlay is append-ov
  155.  
  156. warning !       \ restore warning
  157.  
  158. ovinit
  159.  
  160. only forth also definitions
  161.  
  162.