none of this i/o stuff is documented or tested

1 files changed, 67 insertions, 5 deletions

diff --git a/sanctuary.fs b/sanctuary.fs
index 08a1c15..f3522c5 100644
--- a/sanctuary.fs
+++ b/sanctuary.fs
@@ -24,6 +24,7 @@
 : repeat  branch swap <resolve >resolve ; immediate compile-only
 
 : ?dup  dup 0<> if dup then ;
+: exit  [ hex ] c3 c, [ decimal ] ; immediate \ todo doc
 
 : allot  dp +! ;
 
@@ -57,7 +58,6 @@
 -1 constant true
 
 hex
-\ really i should just change the builtins to work with defer
 : hijacks  ' ( word ) here >r dp ! ( temporarily set dp so we can use , )
 	49 c, bb c, ( xt ) , \ mov r11, xt
 	41 c, ff c, e3 c, \ jmp r11
@@ -136,12 +136,14 @@ decimal
 : mmap  9 syscall6 ;
 : munmap  11 syscall2 ;
 
+\ todo doc
 : allocate ( u -- a e )  >r 0 -1 ( offset fd , unused here )
 	MAP_PRIVATE MAP_ANONYMOUS or ( flags )
 	PROT_READ PROT_WRITE or ( prot )
 	r> 0 ( length addr )
 	mmap >errno ;
 : free ( a u -- e )  swap munmap ;
+: ?allocate  allocate 0< if abort then ;
 \ }}}
 
 \ NUMERIC OUTPUT {{{
@@ -181,13 +183,16 @@ variable hld
 : read-file  >r swap r> sys-read >errno ;
 : write-file  >r swap r> sys-write >errno ;
 
+\ all of this is super ugly
+
 -2 constant init-source
 -1 constant string-source
 init-source value source-id
 
 8192 constant /buffer
+5 constant /buffer-header
 create base-buffer /buffer allot \ stdin input buffer
-variable latest-input-buffer
+variable latest-buffer
 
 \ format: LINK LINEBUF-PTR >IN USED FD [BUFFER (8152B)]
 : buf>line  cell+ ;
@@ -197,15 +202,72 @@ variable latest-input-buffer
 : buf>buf  5 cells + ;
 
 4096 constant /linebuf
+2 constant /linebuf-header
 create base-linebuffer /linebuf allot
 \ format  >IN USED
 : linebuf>used  cell+ ;
 : linebuf>buf  2 cells + ;
 
-base-linebuffer  base-buffer buf>in  !
-base-buffer latest-input-buffer !
+base-linebuffer  base-buffer buf>line  !
+base-buffer latest-buffer !
+
+\ todo doc
+: create-linebuffer ( buf-a -- )  dup /linebuf ?allocate swap buf>line ! ;
+
+: refill-buffer ( a -- u | 0 )  dup >r dup buf>fd @ swap ( fd a )
+	dup buf>in 0 swap !  dup buf>used 0 swap !
+	buf>buf swap >r /buffer /buffer-header - r> read-file ( u e ) drop
+	r> ( u a ) buf>used ! ;
+: create-buffer ( fd -- something? )  /buffer ?allocate ( fd a )
+	dup latest-buffer @ swap !  dup buf>fd rot swap !
+	dup refill-buffer 0= if abort then
+	dup create-linebuffer
+	latest-buffer ! ;
+: free-buffer ( a -- )  dup @ >r
+	dup buf>line @ free free
+	r> latest-buffer ! ;
+
+: cbuffer->in  latest-buffer @ buf>in ;
+: cbuffer-used  latest-buffer @ buf>used ;
+: cbuffer-fd  latest-buffer @ buf>fd ;
+
+: cbuffer-empty?  cbuffer->in @ cbuffer-used @ >= ;
+
+: bufkey ( -- c | -1 )
+	cbuffer-empty? if
+		refill-buffer 0= if -1 exit then
+	then
+	latest-buffer @ cbuffer->in @ + c@
+	cbuffer->in @ 1+ cbuffer->in ! ;
+
+private{
+0 value #read
+0 value #read-limit
+0 value destination-base
+: finish-accept ( -- u )  #read ;
+}private
+\ uses memory for readability, maybe too slow?
+\ need to test to see.
+: accept ( a u -- u )  0 to #read  to #read-limit  to destination-base
+	begin
+		#read #read-limit <
+	while
+		bufkey dup 0>=  over 10 <>  or if
+			destination-base #read + c!
+			1 +to #read
+		else
+			drop finish-accept exit
+		then
+	repeat
+	finish-accept ( only reached when buffer limit reached ) ;
+privatise
+\ }}}
 
-: accept  ;
+\ PROGRAMMING TOOLS {{{
+\ should write top of stack on right
+: .s  ;
+\ gonna need to be rewritten when/if i add vocabulary/wordlist support
+: words  ;
 \ }}}
 
 bye