[BACK]Return to blocks.fs CVS log [TXT] [DIR] Up to [gforth] / gforth

Diff for /gforth/blocks.fs between versions 1.16 and 1.19

version 1.16, 1997/07/06 16:03:24 version 1.19, 1998/12/08 22:02:36
Line 1 Line 1
 \ A less simple implementation of the blocks wordset.   \ A less simple implementation of the blocks wordset. 
   
 \ Copyright (C) 1995 Free Software Foundation, Inc.  \ Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
   
 \ This file is part of Gforth.  \ This file is part of Gforth.
   
Line 32 Line 32
 require struct.fs  require struct.fs
   
 struct  struct
     1           cells: field buffer-block   \ the block number      cell%               field buffer-block   \ the block number
     1           cells: field buffer-fid     \ the block's fid      cell%               field buffer-fid     \ the block's fid
     1           cells: field buffer-dirty   \ the block dirty flag      cell%               field buffer-dirty   \ the block dirty flag
     chars/block chars: field block-buffer   \ the data      char% chars/block * field block-buffer   \ the data
     0           cells: field next-buffer      cell% 0 *           field next-buffer
 end-struct buffer-struct  end-struct buffer-struct
   
 Variable block-buffers  Variable block-buffers
Line 46  $20 Value buffers Line 46  $20 Value buffers
   
 User block-fid  User block-fid
   
 : block-cold  : block-cold ( -- )
     block-fid off  last-block off      block-fid off  last-block off
     buffers buffer-struct drop * allocate throw dup block-buffers !      buffer-struct buffers * %alloc dup block-buffers ! ( addr )
     buffers buffer-struct drop * erase ;      buffer-struct %size buffers * erase ;
   
 ' block-cold INIT8 chained  ' block-cold INIT8 chained
   
Line 59  Defer flush-blocks Line 59  Defer flush-blocks
   
 : open-blocks ( addr u -- ) \ gforth  : open-blocks ( addr u -- ) \ gforth
     \g use the file, whose name is given by @var{addr u}, as blocks file       \g use the file, whose name is given by @var{addr u}, as blocks file 
     2dup ['] open-fpath-file catch 0<>      2dup open-fpath-file 0<>
     if      if
         2drop r/w bin create-file throw          r/w bin create-file throw
     else      else
         rot close-file throw  2dup file-status throw bin open-file throw          rot close-file throw  2dup file-status throw bin open-file throw
         >r 2drop r>          >r 2drop r>
Line 114  Defer flush-blocks Line 114  Defer flush-blocks
 ' flush IS flush-blocks  ' flush IS flush-blocks
   
 : get-buffer ( n -- a-addr )  : get-buffer ( n -- a-addr )
     buffers mod buffer-struct drop * block-buffers @ + ;      buffers mod buffer-struct %size * block-buffers @ + ;
   
 : block ( u -- a-addr )  : block ( u -- a-addr )
     dup 0= -35 and throw      dup 0= -35 and throw
Line 164  User scr 0 scr ! Line 164  User scr 0 scr !
   
 : load ( i*x n -- j*x )  : load ( i*x n -- j*x )
   push-file    push-file
   dup loadline ! blk ! >in off ( ['] ) interpret ( catch )    dup loadline ! blk ! >in off ['] interpret catch
   pop-file ( throw ) ;    pop-file throw ;
   
 : thru ( i*x n1 n2 -- j*x )  : thru ( i*x n1 n2 -- j*x )
   1+ swap ?DO  I load  LOOP ;    1+ swap ?DO  I load  LOOP ;
Removed from v.1.16  
changed lines
  Added in v.1.19

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>