[BACK]Return to blocks.fs CVS log [TXT] [DIR] Up to [gforth] / gforth

Diff for /gforth/blocks.fs between versions 1.1 and 1.4

version 1.1, 1994/08/10 17:22:35 version 1.4, 1995/04/20 09:42:45
Line 6 Line 6
   
 \ I think I avoid the assumption 1 char = 1 here, but I have not tested this  \ I think I avoid the assumption 1 char = 1 here, but I have not tested this
   
 1024 constant chars/block \ mandated by the standard  \ 1024 constant chars/block \ mandated by the standard
   
 create block-buffer chars/block chars allot  create block-buffer chars/block chars allot
   
Line 15  variable block-fid 0 block-fid ! \ the f Line 15  variable block-fid 0 block-fid ! \ the f
 variable buffer-dirty buffer-dirty off  variable buffer-dirty buffer-dirty off
   
   
   \ 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 )
     block-fid @ 0=      block-fid @ 0=
     if      if
         s" blocks.fb" r/w open-file 0<>          s" blocks.fb" r/w bin open-file 0<>
         if          if
             s" blocks.fb" r/w create-file .s throw              s" blocks.fb" r/w bin create-file throw
         then          then
         block-fid !          block-fid !
     then      then
Line 28  variable buffer-dirty buffer-dirty off Line 30  variable buffer-dirty buffer-dirty off
   
 : block-position ( u -- )  : block-position ( u -- )
     \ positions the block file to the start of block u      \ positions the block file to the start of block u
     1- chars/block chars um* get-block-fid reposition-file .s throw ;      1- chars/block chars um* get-block-fid reposition-file throw ;
   
 : update ( -- )  : update ( -- )
     buffer-dirty on ;      buffer-dirty on ;
   
 : save-buffers ( -- )  : save-buffers ( -- )
     buffer-dirty @      buffer-dirty @ buffer-block @ 0<> and
     if      if
         buffer-block @ block-position          buffer-block @ block-position
         block-buffer chars/block get-block-fid write-file throw          block-buffer chars/block get-block-fid write-file throw
Line 54  variable buffer-dirty buffer-dirty off Line 56  variable buffer-dirty buffer-dirty off
     if      if
         save-buffers          save-buffers
         dup block-position          dup block-position
         block-buffer chars/block get-block-fid read-file .s throw          block-buffer chars/block get-block-fid read-file throw
         \ clear the rest of the buffer if the file is too short          \ clear the rest of the buffer if the file is too short
         block-buffer over chars + chars/block rot - blank          block-buffer over chars + chars/block rot - blank
         buffer-block !              buffer-block !    
Line 67  variable buffer-dirty buffer-dirty off Line 69  variable buffer-dirty buffer-dirty off
     \ reading in the block is unnecessary, but simpler      \ reading in the block is unnecessary, but simpler
     block ;      block ;
   
 variable scr 0 scr ! \ !! this should be a user var  User scr 0 scr !
   
 : list ( u -- )  : list ( u -- )
     \ calling block again and again looks inefficient but is necessary      \ calling block again and again looks inefficient but is necessary
Line 76  variable scr 0 scr ! \ !! this should be Line 78  variable scr 0 scr ! \ !! this should be
     ." Screen " u. cr      ." Screen " u. cr
     16 0      16 0
     ?do      ?do
         scr @ block i 64 * chars + 64 type cr          i 2 .r space scr @ block i 64 * chars + 64 type cr
     loop ;      loop ;
   
   : (source)  ( -- addr len )
 \ not yet implemented (with block semantics):    blk @ ?dup
     IF    block chars/block
 \ evaluate    ELSE  tib #tib @
 \ load    THEN ;
 \ refill  
 \ thru  ' (source) IS source
 \ \  
   : load ( i*x n -- j*x )
     push-file
     dup loadline ! blk ! >in off ( ['] ) interpret ( catch )
     pop-file ( throw ) ;
   
   : thru ( i*x n1 n2 -- j*x )
     1+ swap 0 ?DO  I load  LOOP ;
   
   : +load ( i*x n -- j*x )  blk @ + load ;
   
   : +thru ( i*x n1 n2 -- j*x )
     1+ swap 0 ?DO  I +load  LOOP ;
   
   get-current environment-wordlist set-current
   true constant block
   true constant block-ext
   set-current
Removed from v.1.1  
changed lines
  Added in v.1.4

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>