win32forth-cvs

[George H. <geo...@us...>]

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