| \ A less simple implementation of the blocks wordset. |
\ A less simple implementation of the blocks wordset. |
| |
|
| \ An more efficient implementation would use mmap on OSs that |
\ Copyright (C) 1995 Free Software Foundation, Inc. |
| |
|
| |
\ This file is part of Gforth. |
| |
|
| |
\ Gforth is free software; you can redistribute it and/or |
| |
\ modify it under the terms of the GNU General Public License |
| |
\ as published by the Free Software Foundation; either version 2 |
| |
\ of the License, or (at your option) any later version. |
| |
|
| |
\ This program is distributed in the hope that it will be useful, |
| |
\ but WITHOUT ANY WARRANTY; without even the implied warranty of |
| |
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| |
\ GNU General Public License for more details. |
| |
|
| |
\ You should have received a copy of the GNU General Public License |
| |
\ along with this program; if not, write to the Free Software |
| |
\ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. |
| |
|
| |
|
| |
\ A more efficient implementation would use mmap on OSs that |
| \ provide it and many buffers on OSs that do not provide mmap. |
\ provide it and many buffers on OSs that do not provide mmap. |
| |
|
| \ Now, the replacement algorithm is "direct mapped"; change to LRU |
\ Now, the replacement algorithm is "direct mapped"; change to LRU |
| Defer flush-file |
Defer flush-file |
| |
|
| : use-file ( addr u -- ) |
: use-file ( addr u -- ) |
| 2dup r/w bin open-file 0<> |
2dup ['] open-path-file catch 0<> |
| if |
if |
| drop r/w bin create-file throw |
2drop r/w bin create-file throw |
| else |
else |
| nip nip |
rot close-file throw 2dup file-status throw bin open-file throw |
| |
>r 2drop r> |
| then |
then |
| block-fid @ IF flush-file block-fid @ close-file throw THEN |
block-fid @ IF flush-file block-fid @ close-file throw THEN |
| block-fid ! ; |
block-fid ! ; |
| |
|
| |
: use ( "file" -- ) |
| |
name use-file ; |
| |
|
| \ the file is opened as binary file, since it either will contain text |
\ the file is opened as binary file, since it either will contain text |
| \ without newlines or binary data |
\ without newlines or binary data |
| : get-block-fid ( -- fid ) |
: get-block-fid ( -- fid ) |