Adding crude blocks and block editor.

ueforth/Makefile

@@ -116,7 +116,7 @@ $(GEN):
 POSIX_BOOT =  common/boot.fs common/terminal.fs \
               posix/posix.fs posix/posix_highlevel.fs \
               common/filetools.fs posix/posix_desktop.fs \
-              common/tasks.fs common/streams.fs
+              common/tasks.fs common/streams.fs common/blocks.fs
 $(GEN)/posix_boot.h: common/source_to_string.js $(POSIX_BOOT) | $(GEN)
 	echo "ok" | cat $(POSIX_BOOT) - | $< boot >$@
 

ueforth/common/blocks.fs

@@ -0,0 +1,41 @@
+( Block Files )
+-1 value block-fid   variable scr   -1 value block-id   0 value block-dirty
+create block-data 1024 allot
+: open-blocks ( a n -- )
+   block-fid 0< 0= if block-fid close-file throw -1 to block-fid then
+   2dup r/w open-file if drop r/w create-file throw else nip nip then to block-fid ;
+: use ( "name" -- ) bl parse open-blocks ;
+: save-buffers
+   block-dirty if
+     block-id 1024 * block-fid reposition-file throw
+     block-data 1024 block-fid write-file throw
+     block-fid flush-file throw
+     0 to block-dirty
+   then ;
+: clobber-line ( a -- a' ) dup 63 bl fill 63 + nl over c! 1+ ;
+: clobber ( a -- ) 15 for clobber-line next drop ;
+: block ( n -- a ) dup block-id = if drop block-data exit then
+                   save-buffers dup 1024 * block-fid reposition-file throw
+                   block-data clobber
+                   block-data 1024 block-fid read-file throw drop
+                   to block-id block-data ;
+: buffer ( n -- a ) dup block-id = if drop block-data exit then
+                    save-buffers to block-id block-data ;
+: empty-buffers   -1 to block-id ;
+: update   -1 to block-dirty ;
+: flush   save-buffers empty-buffers ;
+
+( Loading )
+: load ( n -- ) block 1024 evaluate ;
+: thru ( a b -- ) over - 1+ for aft dup >r load r> 1+ then next drop ;
+
+( Editing )
+: list ( n -- ) scr ! ." Block " scr @ . cr scr @ block
+   15 for dup 63 type [char] | emit space 15 r@ - . cr 64 + next drop ;
+: l    scr @ list ;   : n    1 scr +! l ;  : p   -1 scr +! l ;
+: @line ( n -- ) 64 * scr @ block + ;
+: e' ( n -- ) @line clobber-line drop update ;
+: wipe   15 for r@ e' next l ;   : e   e' l ;
+: d ( n -- ) dup 1+ @line swap @line 15 @line over - cmove 15 e ;
+: r ( n "line" -- ) 0 parse 64 min rot dup e @line swap cmove l ;
+: a ( n "line" -- ) dup @line over 1+ @line 16 @line over - cmove> r ;

ueforth/common/boot.fs

@@ -176,6 +176,7 @@ variable hld
 
 ( Fill, Move )
 : cmove ( a a n -- ) for aft >r dup c@ r@ c! 1+ r> 1+ then next 2drop ;
+: cmove> ( a a n -- ) for aft 2dup swap r@ + c@ swap r@ + c! then next 2drop ;
 : fill ( a a n -- ) swap for swap aft 2dup c! 1 + then next 2drop ;
 
 ( Better Errors )

ueforth/common/core.h

@@ -87,6 +87,7 @@ static cell_t *evaluate1(cell_t *sp) {
   cell_t call = 0;
   cell_t name;
   cell_t len = parse(' ', &name);
+  if (len == 0) { *++sp = 0; return sp; }  // ignore empty
   cell_t xt = find((const char *) name, len);
   if (xt) {
     if (g_sys.state && !(((cell_t *) xt)[-1] & 1)) {  // bit 0 of flags is immediate

ueforth/posix/posix.fs

@@ -21,6 +21,7 @@ z" close" 1 sysfunc close
 z" read" 3 sysfunc read
 z" write" 3 sysfunc write
 z" lseek" 3 sysfunc lseek
+z" fsync" 1 sysfunc fsync
 z" exit" 1 sysfunc sysexit
 z" fork" 0 sysfunc fork
 z" wait" 1 sysfunc wait
@@ -87,11 +88,13 @@ octal 777 constant 0777 decimal
 : create-file ( a n fam -- fh ior )
    >r s>z r> O_CREAT or 0777 open sign-extend 0<ior ;
 : close-file ( fh -- ior ) close sign-extend ;
+: flush-file ( fh -- ior ) fsync sign-extend ;
 : delete-file ( a n -- ior ) s>z unlink sign-extend ;
 : rename-file ( a n a n -- ior ) s>z -rot s>z swap rename sign-extend ;
 : read-file ( a n fh -- n ior ) -rot read 0<ior ;
 : write-file ( a n fh -- ior ) -rot dup >r write r> = 0= ;
 : file-position ( fh -- n ior ) dup 0 SEEK_CUR lseek 0<ior ;
+: reposition-file ( n fh -- ior ) swap SEEK_SET lseek 0< ;
 : file-size ( fh -- n ior )
    dup 0 SEEK_CUR lseek >r
    dup 0 SEEK_END lseek r> swap >r