win32forth-cvs Mailing List for Win32Forth (Page 61)

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

Update of /cvsroot/win32forth/win32forth/src/lib
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv25593/win32forth/src/lib

Modified Files:
	BLOCK.F 
Log Message:
gah:Added documentation

Index: BLOCK.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/lib/BLOCK.F,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** BLOCK.F	3 Oct 2006 07:44:22 -0000	1.4
--- BLOCK.F	17 Oct 2006 08:52:19 -0000	1.5
***************
*** 4,31 ****
  cr .( Loading BLOCK...)

! comment:
! 
!   Here is an impementation of a virtual block system.  The constants below,
! B/BUF, and #BUFFERS control the record or block size, and the number of
! buffers the system uses.  These are defaulted to 1024 byte blocks, and
! 4 buffers.  A true LRU (least recently used) buffer allocation mechanism
! is used, implemented as a bubble up buffer stack.  The least recently used
! buffer is always on the bottom of the stack.  As buffers are used or
! re-used, they are bubbled immediately up to the top of the stack, destined
! to settle to the bottom of the stack if the same record is not accessed
! again.
! 
! A sample block file BANNER.BLK has been included for your examination.
! 
! type the following commands after loading BLOCK.F
! 
!         OPEN-BLOCKFILE BANNER.BLK
!         1 7 THRU
! 
! This will load and run a simple demo.

! Type DEMO again to run it again after it has been loaded.

! comment;

  only forth also definitions
--- 4,41 ----
  cr .( Loading BLOCK...)

! \ *D doc
! \ *! p-block W32F block
! \ *T Using the Block Wordset

! \ *P Win32Forth implements a virtual block system, based on the ANSI standard Block
! \ ** and Block extension wordsets. \n
! \ ** The block words are not loaded by default and have to be included. The file
! \ ** BLOCK.F is in the lib folder (some older versions of W32F placed it in the extras
! \ ** folder). \n
! \ ** The constants B/BUF, and #BUFFERS control the block size, and the number of
! \ ** buffers the system uses.  These are defaulted to 1024 byte blocks, and
! \ ** 8 buffers.  A true LRU (least recently used) buffer allocation mechanism
! \ ** is used, implemented as a bubble up buffer stack.  The least recently used
! \ ** buffer is always on the bottom of the stack.  As buffers are used or
! \ ** re-used, they are bubbled immediately up to the top of the stack, destined
! \ ** to settle to the bottom of the stack if the same record is not accessed
! \ ** again. \n Blocks are stored in a blockfile (normally with the .blk extension,
! \ ** although some forths use .fb) which is set by the words set-blockfile,
! \ ** open-blockfile or create-blockfile and closed by close-blockfile. Only one
! \ ** blockfile is active at any one time, open-blockfile and create-blockfile
! \ ** automatically close the current one prior to setting themselves as the current
! \ ** blockfile. \n
! \ ** \b NOTE \d set-blockfile does not close the current blockfile.

! \ A sample block file BANNER.BLK has been included for your examination.
! \
! \ type the following commands after loading BLOCK.F
! \
! \         OPEN-BLOCKFILE BANNER.BLK
! \         1 7 THRU
! \
! \ This will load and run a simple demo.
! \
! \ Type DEMO again to run it again after it has been loaded.

  only forth also definitions
***************
*** 35,47 ****
  \ needs 486asm.f                        \ load assembler if needed

!         1024 constant b/buf             \ length of each block
!           64 constant c/l               \ character per line
!            8 constant #buffers          \ number of virtual buffers
!           -1    value blockhandle       \ current block file handle

! variable blk                            \ current block number
! variable scr                            \ current screen number

! only forth also definitions

  INTERNAL                                \ internal definitions
--- 45,67 ----
  \ needs 486asm.f                        \ load assembler if needed

! \ *S Glossary

!         1024 constant b/buf                    \ W32F         Block extra
! \ *G Length of each block.
!           64 constant c/l                      \ W32F         Block extra
! \ *G Number of characters per line.
!            8 constant #buffers                 \ W32F         Block extra
! \ *G Number of block buffers.
!           -1    value blockhandle              \ W32F         Block extra
! \ *G The handle of the current block file, or -1 if no current block file.

! variable blk        ( -- a-addr )              \ ANSI         Block
! \ *G a-addr is the address of a cell containing zero or the number of the mass-storage
! \ ** block being interpreted. If BLK contains zero, the input source is not a block
! \ ** and can be identified by SOURCE-ID, if SOURCE-ID is available. An ambiguous
! \ ** condition exists if a program directly alters the contents of BLK.
! variable scr        ( -- a-addr )              \ ANSI         Block ext
! \ *G a-addr is the address of a cell containing the block number of the block most
! \ ** recently listed.

  INTERNAL                                \ internal definitions
***************
*** 121,127 ****
  EXTERNAL        \ externally available definitions

!                                 \ n1 = block #
!                                 \ a1 = bufadr
! : save-buffers  ( -- )          \ save all updated buffers to disk
          #buffers 0                              \ through all the buffers
          do      rec#use @ >r                    \ find a buffer
--- 141,149 ----
  EXTERNAL        \ externally available definitions

!                                 \ u = block #
!                                 \ a-addr = bufadr
! : save-buffers      ( -- )                     \ ANSI         Block
! \ *G Transfer the contents of each updated block buffer to mass storage.
! \ ** Mark all buffers as unmodified.
          #buffers 0                              \ through all the buffers
          do      rec#use @ >r                    \ find a buffer
***************
*** 136,140 ****
          loop    ;

! : buffer        ( n1 -- a1 )            \ Assign least used buffer to rec n1
          dup ?gotrec                     \ check if already present
          if      >r drop                 \ buffer already assigned, save it
--- 158,173 ----
          loop    ;

! : buffer            ( u -- a-addr )            \ ANSI         Block
! \ *G a-addr is the address of the first character of the block buffer assigned to block u.
! \ ** The contents of the block are unspecified. An ambiguous condition exists if u is not
! \ ** an available block number. \n
! \ ** If block u is already in a block buffer, a-addr is the address of that block buffer. \n
! \ ** If block u is not already in memory and there is an unassigned buffer, a-addr is the
! \ ** address of that block buffer. \n
! \ ** If block u is not already in memory and there are no unassigned block buffers,
! \ ** unassign a block buffer. If the block in that buffer has been UPDATEd, transfer
! \ ** the block to mass storage. a-addr is the address of that block buffer.
! \ ** At the conclusion of the operation, the block buffer pointed to by a-addr is
! \ ** the current block buffer and is assigned to u.
          dup ?gotrec                     \ check if already present
          if      >r drop                 \ buffer already assigned, save it
***************
*** 154,158 ****
          r> buf#>bufaddr ;               \ calc buffer addr

! : empty-buffers ( -- )                 \ clean out the virtual buffers
          rec_array b/buf #buffers * erase
          rec#s    buflen -1 fill
--- 187,193 ----
          r> buf#>bufaddr ;               \ calc buffer addr

! : empty-buffers     ( -- )                     \ ANSI         Block ext
! \ *G Unassign all block buffers. Do not transfer the contents of any updated
! \ ** block buffer to mass storage.
          rec_array b/buf #buffers * erase
          rec#s    buflen -1 fill
***************
*** 164,177 ****
          drop ;

! : flush         ( -- )                 \ Write any updated buffers to disk
          save-buffers
          empty-buffers ;

! : update        ( -- )                 \ mark the current block as updated
          cur_buffer# @ >rec#updt on ;

!                                        \ n1 = block # to get
!                                        \ a1 is address of block # n1
! : block         ( n1 -- a1 )           \ Get block n1 into memory
          dup ?gotrec
          if      nip dup >r buf#>bufaddr
--- 199,229 ----
          drop ;

! : flush             ( -- )                     \ ANSI         Block
! \ *G Perform the function of SAVE-BUFFERS, then unassign all block buffers.
          save-buffers
          empty-buffers ;

! : update            ( -- )                     \ ANSI         Block
! \ *G Mark the current block buffer as modified. An ambiguous condition exists if there
! \ ** is no current block buffer. \n
! \ ** Update does not write the block to the disc.
          cur_buffer# @ >rec#updt on ;

!                                        \ u = block # to get
!                                        \ a-addr is address of block # u
! : block             ( u -- a-addr )            \ ANSI         Block
! \ *G a-addr is the address of the first character of the block buffer assigned to
! \ ** mass-storage block u. An ambiguous condition exists if u is not an available
! \ ** block number. \n
! \ ** If block u is already in a block buffer, a-addr is the address of that block buffer.  \n
! \ ** If block u is not already in memory and there is an unassigned block buffer,
! \ ** transfer block u from mass storage to an unassigned block buffer. a-addr is
! \ ** the address of that block buffer. \n
! \ ** If block u is not already in memory and there are no unassigned block buffers, unassign
! \ ** a block buffer. If the block in that buffer has been UPDATEd, transfer the block to
! \ ** mass storage and transfer block u from mass storage into that buffer. a-addr is the
! \ ** address of that block buffer. \n
! \ ** At the conclusion of the operation, the block buffer pointed to by a-addr is the
! \ ** current block buffer and is assigned to u.
          dup ?gotrec
          if      nip dup >r buf#>bufaddr
***************
*** 181,185 ****
          then    ;

! : list          ( n1 -- )       \ display block n1 on the console
          dup scr !
          block b/buf bounds
--- 233,239 ----
          then    ;

! : list              ( u -- )                   \ ANSI         Block ext
! \ *G Display block u in the console in a 16 line format. Store u in SCR. \n
! \ ** An error occurs if u is greater than the number of blocks in the current blockfile.
          dup scr !
          block b/buf bounds
***************
*** 187,196 ****
          c/l +loop    ;

! : wipe          ( n1 -- )       \ erase the specified block to blanks
          buffer b/buf blank update ;

! : set-blockfile ( fileid -- )
          to blockhandle ;

  warning off

--- 241,257 ----
          c/l +loop    ;

! : wipe              ( u -- )                   \ W32F         Block extra
! \ *G Erase the specified block to blanks.
          buffer b/buf blank update ;

! : set-blockfile     ( fileid -- )              \ W32F         Block extra
! \ *G Make fileid the current blockfile.
          to blockhandle ;

+ \ ----------------------------------------------------------------
+ \ The following words add capabities for dealing with blocks.
+ \ See the documentation for what they do.
+ \ ----------------------------------------------------------------
+ 
  warning off

***************
*** 244,248 ****
  ' blkmessage is message

! : load          { loadblk \ incntr outcntr -- }
          save-input dup 1+ dup to incntr
                                to outcntr
--- 305,319 ----
  ' blkmessage is message

! \ ----------------------------------------------------------------
! \ -------- End of extended capabilities --------------------------
! \ ----------------------------------------------------------------
! 
! : load              ( i*x u -- j*x )           \ ANSI         Block
! \ *G Save the current input-source specification. Store u in BLK (thus making block
! \ ** u the input source and setting the input buffer to encompass its contents), set
! \ ** >IN to zero, and interpret. When the parse area is exhausted, restore the prior
! \ ** input source specification. Other stack effects are due to the words LOADed.
! \ ** An ambiguous condition exists if u is zero or is not a valid block number.
!         { loadblk \ incntr outcntr -- }
          save-input dup 1+ dup to incntr
                                to outcntr
***************
*** 256,265 ****
          restore-input drop ;

! : thru          ( n1 n2 -- )
          1+ swap
          ?do     i load
          loop    ;

! : close-blockfile ( -- )
          blockhandle -1 <>
          if      flush
--- 327,340 ----
          restore-input drop ;

! : thru              ( i*x u1 u2 -- j*x )       \ ANSI         Block ext
! \ *G LOAD the mass storage blocks numbered u1 through u2 in sequence. Other stack
! \ ** effects are due to the words LOADed.
          1+ swap
          ?do     i load
          loop    ;

! : close-blockfile   ( -- )                     \ W32F         Block extra
! \ *G Close the current blockfile, flushing any updated buffers. Set the current blockfile
! \ ** to no file.
          blockhandle -1 <>
          if      flush
***************
*** 268,272 ****
          then    -1 to blockhandle ;

! : open-blockfile ( -<filename>- )
          close-blockfile
          /parse-word count r/w open-file abort" Failed to open Block File"
--- 343,348 ----
          then    -1 to blockhandle ;

! : open-blockfile    ( "<spaces>'filename'" )   \ W32F         Block extra
! \ *G Close the current blockfile. Open the file and make it the current block file.
          close-blockfile
          /parse-word count r/w open-file abort" Failed to open Block File"
***************
*** 274,278 ****
          empty-buffers ;

! : create-blockfile ( u1 -<filename>- )  \ create a blank file of u1 block long
          close-blockfile
          /parse-word count r/w create-file
--- 350,356 ----
          empty-buffers ;

! : create-blockfile  ( u "<spaces>'filename'" ) \ W32F         Block extra
! \ *G Close the current blockfile. Create a file of u blocks long, initialise the
! \ ** blocks to blanks and make it the current blockfile.
          close-blockfile
          /parse-word count r/w create-file
***************
*** 287,291 ****
          flush ;

! : #blocks       ( -- n1 )       \ return the number of block in the current file
          blockhandle file-size drop b/buf um/mod nip ;

--- 365,370 ----
          flush ;

! : #blocks           ( -- u )                   \ W32F         Block extra
! \ *G u is the number of blocks in the current blockfile.
          blockhandle file-size drop b/buf um/mod nip ;

***************
*** 306,316 ****
  MODULE          \ end of the module

! environment definitions
! 
! : BLOCK         TRUE ;
! 
! : BLOCK-EXT     TRUE ;

! only forth also definitions

--- 385,394 ----
  MODULE          \ end of the module

! get-current checkstack also environment definitions

! true constant BLOCK
! true constant BLOCK-EXT

+ previous set-current

+ \ *Z

2004	Jan	Feb	Mar	Apr	May	Jun	Jul	Aug	Sep	Oct	Nov	Dec (70)
2005	Jan (38)	Feb (4)	Mar (11)	Apr (49)	May (81)	Jun (65)	Jul (36)	Aug (57)	Sep (63)	Oct (57)	Nov (49)	Dec (41)
2006	Jan (75)	Feb (80)	Mar (10)	Apr (13)	May (100)	Jun (100)	Jul (77)	Aug (87)	Sep (80)	Oct (124)	Nov (39)	Dec (41)
2007	Jan (20)	Feb (32)	Mar (32)	Apr (43)	May (146)	Jun (40)	Jul (49)	Aug (33)	Sep (25)	Oct (19)	Nov (11)	Dec (8)
2008	Jan (4)	Feb (11)	Mar (31)	Apr (40)	May (34)	Jun (24)	Jul (39)	Aug (104)	Sep (27)	Oct (35)	Nov (34)	Dec (97)
2009	Jan (75)	Feb (29)	Mar (45)	Apr (76)	May (121)	Jun (103)	Jul (67)	Aug (28)	Sep (22)	Oct (39)	Nov (9)	Dec (15)
2010	Jan (7)	Feb (39)	Mar (40)	Apr (57)	May (67)	Jun (69)	Jul (49)	Aug (68)	Sep (22)	Oct (7)	Nov (2)	Dec (10)
2011	Jan	Feb	Mar (10)	Apr (4)	May (6)	Jun (10)	Jul (16)	Aug (23)	Sep (9)	Oct	Nov (28)	Dec (3)
2012	Jan (11)	Feb (10)	Mar (1)	Apr	May (4)	Jun (3)	Jul (3)	Aug (4)	Sep (2)	Oct	Nov	Dec (1)
2013	Jan	Feb (7)	Mar (30)	Apr (4)	May (4)	Jun (8)	Jul (10)	Aug (4)	Sep	Oct (2)	Nov (24)	Dec (13)
2014	Jan (7)	Feb (2)	Mar	Apr (1)	May (9)	Jun	Jul (3)	Aug (9)	Sep	Oct (2)	Nov	Dec (3)
2015	Jan (4)	Feb (2)	Mar	Apr	May	Jun (1)	Jul	Aug (5)	Sep (1)	Oct (4)	Nov (7)	Dec (39)
2016	Jan (17)	Feb (2)	Mar (2)	Apr	May (1)	Jun (1)	Jul	Aug	Sep	Oct	Nov (1)	Dec (2)
2017	Jan	Feb (3)	Mar	Apr	May (1)	Jun (2)	Jul	Aug (3)	Sep	Oct	Nov	Dec (2)
2018	Jan	Feb	Mar (2)	Apr	May	Jun	Jul	Aug	Sep	Oct	Nov	Dec
2019	Jan	Feb	Mar (1)	Apr	May	Jun	Jul	Aug	Sep	Oct	Nov	Dec
2022	Jan	Feb	Mar	Apr	May (1)	Jun	Jul	Aug	Sep (1)	Oct (2)	Nov (1)	Dec (1)
2023	Jan	Feb	Mar	Apr	May	Jun	Jul	Aug (1)	Sep	Oct (1)	Nov	Dec
2025	Jan	Feb	Mar	Apr	May	Jun (1)	Jul	Aug	Sep	Oct	Nov	Dec

win32forth-cvs Mailing List for Win32Forth (Page 61)

win32forth-cvs — CVS Commit List