version 1.5, 1995/08/29 21:07:33
|
version 1.9, 1996/07/16 20:57:06
|
Line 1
|
Line 1
|
\ 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 |
Line 39 block-cold
|
Line 58 block-cold
|
Defer flush-file |
Defer flush-file |
|
|
: use-file ( addr u -- ) |
: use-file ( addr u -- ) |
block-fid @ IF flush-file block-fid @ close-file throw THEN |
2dup ['] open-path-file catch 0<> |
2dup r/w bin open-file 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 ! ; |
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 ) |
Line 95 Defer flush-file
|
Line 118 Defer flush-file
|
dup 0= -35 and throw |
dup 0= -35 and throw |
dup get-buffer >r |
dup get-buffer >r |
dup r@ buffer-block @ <> |
dup r@ buffer-block @ <> |
r@ buffer-fid @ block-fid @ <> and |
r@ buffer-fid @ block-fid @ <> or |
if |
if |
r@ save-buffer |
r@ save-buffer |
dup block-position |
dup block-position |