--- gforth/blocks.fs	1997/03/20 14:39:49	1.12
+++ gforth/blocks.fs	1999/02/03 00:10:19	1.21
@@ -1,6 +1,6 @@
 \ 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.
 
@@ -32,11 +32,11 @@
 require struct.fs
 
 struct
-    1           cells: field buffer-block   \ the block number
-    1           cells: field buffer-fid     \ the block's fid
-    1           cells: field buffer-dirty   \ the block dirty flag
-    chars/block chars: field block-buffer   \ the data
-    0           cells: field next-buffer
+    cell%		field buffer-block   \ the block number
+    cell%		field buffer-fid     \ the block's fid
+    cell%		field buffer-dirty   \ the block dirty flag
+    char% chars/block * field block-buffer   \ the data
+    cell% 0 *		field next-buffer
 end-struct buffer-struct
 
 Variable block-buffers
@@ -46,12 +46,12 @@ $20 Value buffers
 
 User block-fid
 
-: block-cold
-    defers 'cold  block-fid off  last-block off
-    buffers buffer-struct drop * allocate throw dup block-buffers !
-    buffers buffer-struct drop * erase ;
+: block-cold ( -- )
+    block-fid off  last-block off
+    buffer-struct buffers * %alloc dup block-buffers ! ( addr )
+    buffer-struct %size buffers * erase ;
 
-' block-cold IS 'cold
+' block-cold INIT8 chained
 
 block-cold
 
@@ -59,9 +59,9 @@ Defer flush-blocks
 
 : open-blocks ( addr u -- ) \ gforth
     \g use the file, whose name is given by @var{addr u}, as blocks file 
-    2dup ['] open-path-file catch 0<>
+    2dup open-fpath-file 0<>
     if
-	2drop r/w bin create-file throw
+	r/w bin create-file throw
     else
 	rot close-file throw  2dup file-status throw bin open-file throw
 	>r 2drop r>
@@ -75,21 +75,22 @@ Defer flush-blocks
 
 \ the file is opened as binary file, since it either will contain text
 \ without newlines or binary data
-: get-block-fid ( -- fid )
+: get-block-fid ( -- fid ) \ gforth
     block-fid @ 0=
     if
 	s" blocks.fb" open-blocks
     then
     block-fid @ ;
 
-: block-position ( u -- )
-    \ positions the block file to the start of block u
+: block-position ( u -- ) \ block
+    \G Position the block file to the start of block u.
     1- chars/block chars um* get-block-fid reposition-file throw ;
 
-: update ( -- )
+: update ( -- ) \ block
     last-block @ ?dup IF  buffer-dirty on  THEN ;
 
-: save-buffer ( buffer -- ) >r
+: save-buffer ( buffer -- ) \ gforth
+    >r
     r@ buffer-dirty @ r@ buffer-block @ 0<> and
     if
 	r@ buffer-block @ block-position
@@ -98,25 +99,30 @@ Defer flush-blocks
     endif
     rdrop ;
 
-: empty-buffer ( buffer -- )
+: empty-buffer ( buffer -- ) \ gforth
     buffer-block off ;
 
-: save-buffers  ( -- )    block-buffers @
+: save-buffers  ( -- ) \ block
+    block-buffers @
     buffers 0 ?DO  dup save-buffer  next-buffer  LOOP  drop ;
 
-: empty-buffers ( -- )    block-buffers @
+: empty-buffers ( -- ) \ block
+    block-buffers @
     buffers 0 ?DO  dup empty-buffer  next-buffer  LOOP  drop ;
 
-: flush ( -- )
+: flush ( -- ) \ block
     save-buffers
     empty-buffers ;
 
 ' flush IS flush-blocks
 
-: get-buffer ( n -- a-addr )
-    buffers mod buffer-struct drop * block-buffers @ + ;
+: get-buffer ( n -- a-addr ) \ gforth
+    buffers mod buffer-struct %size * block-buffers @ + ;
 
-: block ( u -- a-addr )
+: block ( u -- a-addr ) \ block- block
+  \G u identifies a block number. Assign a block buffer to u,
+  \G make it the current block buffer and return its start
+  \G address, a-addr.
     dup 0= -35 and throw
     dup get-buffer >r
     dup r@ buffer-block @ <>
@@ -134,16 +140,21 @@ Defer flush-blocks
     then
     r> dup last-block ! block-buffer ;
 
-: buffer ( u -- a-addr )
+: buffer ( u -- a-addr ) \ block
     \ reading in the block is unnecessary, but simpler
     block ;
 
-User scr 0 scr !
+User scr ( -- a-addr ) \ block-ext
+    \G USER VARIABLE a-addr is the address of a cell containing
+    \G the block number of the block most recently processed by
+    \G @code{LIST}.
+    0 scr !
 
-: updated?  ( n -- f )   scr @ buffer
+: updated?  ( n -- f ) \ gforth
+    scr @ buffer
     [ 0 buffer-dirty 0 block-buffer - ] Literal + @ ;
 
-: list ( u -- )
+: list ( u -- ) \ block
     \ calling block again and again looks inefficient but is necessary
     \ in a multitasking environment
     dup scr !
@@ -162,33 +173,41 @@ User scr 0 scr !
 
 ' (source) IS source
 
-: load ( i*x n -- j*x )
+: load ( i*x n -- j*x ) \ block
   push-file
-  dup loadline ! blk ! >in off ( ['] ) interpret ( catch )
-  pop-file ( throw ) ;
+  dup loadline ! blk ! >in off ['] interpret catch
+  pop-file throw ;
 
-: thru ( i*x n1 n2 -- j*x )
-  1+ swap 0 ?DO  I load  LOOP ;
+: thru ( i*x n1 n2 -- j*x ) \ block
+  1+ swap ?DO  I load  LOOP ;
 
-: +load ( i*x n -- j*x )  blk @ + load ;
+: +load ( i*x n -- j*x ) \ block
+    blk @ + load ;
 
-: +thru ( i*x n1 n2 -- j*x )
-  1+ swap 0 ?DO  I +load  LOOP ;
+: +thru ( i*x n1 n2 -- j*x ) \ block
+  1+ swap ?DO  I +load  LOOP ;
 
-: --> ( -- )  refill drop ; immediate
+: --> ( -- ) \ block- block
+    \G If this symbol is encountered whilst loading block @var{n},
+    \G discard the remainder of the block and load block @var{n+1}. Used
+    \G for chaining multiple blocks together as a single loadable unit.
+    refill drop ; immediate
 
-: block-included ( addr u -- )
+: block-included ( addr u -- ) \ gforth
     block-fid @ >r block-fid off open-blocks
     1 load block-fid @ close-file throw flush
     r> block-fid ! ;
 
-: include ( "name" -- )
-    name 2dup dup 3 - /string s" .fb" compare
-    0= IF  block-included  ELSE  included  THEN ;
+\ thrown out because it may provide unpleasant surprises - anton
+\ : include ( "name" -- )
+\     name 2dup dup 3 - /string s" .fb" compare
+\     0= IF  block-included  ELSE  included  THEN ;
 
 get-current environment-wordlist set-current
 true constant block
 true constant block-ext
 set-current
 
-: bye  ['] flush catch drop bye ;
\ No newline at end of file
+: bye ( -- ) \ tools-ext
+  \G Return control to the host operating system (if any).
+  ['] flush catch drop bye ;