home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / tblock.seq < prev    next >
Encoding:
Text File  |  1989-11-02  |  1.4 KB  |  55 lines
  1. \ TBLOCK.SEQ            Virtual BLOCK system for TCOM   by Tom Zimmer
  2.  
  3. comment:
  4.  
  5.   This is a very simple BLOCK system, supporting only a single buffer
  6. at present. Be sure to use EMPTY-BUFFERS before using any other BLOCK
  7. word.
  8.  
  9. comment;
  10.  
  11. FORTH DECIMAL TARGET >LIBRARY       \ A Library file
  12.  
  13. 1024 value b/buf
  14.    0 value blkbuf
  15.     handle blkhndl
  16.   variable updated
  17.   variable blk
  18.  
  19. : save-buffers  ( -- )
  20.                 blk @ 0< ?exit
  21.                 updated @
  22.                 if      blk @ b/buf *d blkhndl movepointer
  23.                         blkbuf b/buf blkhndl hwrite drop
  24.                         updated off
  25.                 then    ;
  26.  
  27. : flush         ( -- )
  28.                 save-buffers -1 blk ! ;
  29.  
  30. : buffer        ( n1 -- a1 )
  31.                 save-buffers
  32.                 blk ! blkbuf ;
  33.  
  34. : block         ( n1 -- a1 )
  35.                 blk @ over <>
  36.                 if      save-buffers
  37.                         dup blk !
  38.                         b/buf *d blkhndl movepointer
  39.                         blkbuf b/buf blkhndl hread drop
  40.                 else    drop
  41.                 then    blkbuf ;
  42.  
  43. : update        ( -- )
  44.                 updated on ;
  45.  
  46. : empty-buffers ( -- )
  47.                 updated off
  48.                 -1 blk !
  49.                 blkbuf 0=       \ allocate some buffer space the first time
  50.                 if      b/buf ds:alloc =: blkbuf
  51.                 then    ;
  52.  
  53. FORTH TARGET >TARGET
  54.  
  55.