Return to blocks.fs CVS log

Up to [gforth] / gforth

Annotation of gforth/blocks.fs, revision 1.1

1.1     ! anton       1: \ A simple immplementation of the blocks wordset. 
        !             2: 
        !             3: \ This implementation uses only a single buffer and will therefore be a
        !             4: \ little slow. An efficient implementation would use mmap on OSs that
        !             5: \ provide it and many buffers on OSs that do not provide mmap.
        !             6: 
        !             7: \ I think I avoid the assumption 1 char = 1 here, but I have not tested this
        !             8: 
        !             9: 1024 constant chars/block \ mandated by the standard
        !            10: 
        !            11: create block-buffer chars/block chars allot
        !            12: 
        !            13: variable buffer-block 0 buffer-block ! \ the block currently in the buffer
        !            14: variable block-fid 0 block-fid ! \ the file id of the current block file
        !            15: variable buffer-dirty buffer-dirty off
        !            16: 
        !            17: 
        !            18: : get-block-fid ( -- fid )
        !            19:     block-fid @ 0=
        !            20:     if
        !            21:        s" blocks.fb" r/w open-file 0<>
        !            22:        if
        !            23:            s" blocks.fb" r/w create-file .s throw
        !            24:        then
        !            25:        block-fid !
        !            26:     then
        !            27:     block-fid @ ;
        !            28: 
        !            29: : block-position ( u -- )
        !            30:     \ positions the block file to the start of block u
        !            31:     1- chars/block chars um* get-block-fid reposition-file .s throw ;
        !            32: 
        !            33: : update ( -- )
        !            34:     buffer-dirty on ;
        !            35: 
        !            36: : save-buffers ( -- )
        !            37:     buffer-dirty @
        !            38:     if
        !            39:        buffer-block @ block-position
        !            40:        block-buffer chars/block get-block-fid write-file throw
        !            41:        buffer-dirty off
        !            42:     endif ;
        !            43: 
        !            44: : empty-buffers ( -- )
        !            45:     0 buffer-block ! ;
        !            46: 
        !            47: : flush ( -- )
        !            48:     save-buffers
        !            49:     empty-buffers ;
        !            50: 
        !            51: : block ( u -- a-addr )
        !            52:     dup 0= -35 and throw
        !            53:     dup buffer-block @ <>
        !            54:     if
        !            55:        save-buffers
        !            56:        dup block-position
        !            57:        block-buffer chars/block get-block-fid read-file .s throw
        !            58:        \ clear the rest of the buffer if the file is too short
        !            59:        block-buffer over chars + chars/block rot - blank
        !            60:        buffer-block !    
        !            61:     else
        !            62:        drop
        !            63:     then
        !            64:     block-buffer ;
        !            65: 
        !            66: : buffer ( u -- a-addr )
        !            67:     \ reading in the block is unnecessary, but simpler
        !            68:     block ;
        !            69: 
        !            70: variable scr 0 scr ! \ !! this should be a user var
        !            71: 
        !            72: : list ( u -- )
        !            73:     \ calling block again and again looks inefficient but is necessary
        !            74:     \ in a multitasking environment
        !            75:     dup scr !
        !            76:     ." Screen " u. cr
        !            77:     16 0
        !            78:     ?do
        !            79:        scr @ block i 64 * chars + 64 type cr
        !            80:     loop ;
        !            81: 
        !            82: 
        !            83: \ not yet implemented (with block semantics):
        !            84: 
        !            85: \ evaluate
        !            86: \ load
        !            87: \ refill
        !            88: \ thru
        !            89: \ \