revise File device according to new tests

exe/uxnemu.ml

@@ -28,14 +28,14 @@ let run m pc =
   let dev = Machine.dev m in
   try Machine.dispatch m pc with
   | effect Machine.BRK, _ -> ()
-  | effect Machine.DEI (`Byte, port), k -> begin
+  | effect Machine.DEI port, k -> begin
       try
         let module Device = (val Hashtbl.find devices_dei port : Device.DEVICE)
         in
         continue k (Device.dei m port)
       with Not_found -> continue k (Bytes.get_uint8 dev port)
     end
-  | effect Machine.DEI (`Short, port), k -> begin
+  | effect Machine.DEI2 port, k -> begin
       try
         let module Device = (val Hashtbl.find devices_dei port : Device.DEVICE)
         in

lib/Machine.ml

@@ -68,7 +68,8 @@ type machine =
 
 type _ Effect.t +=
   | BRK : int Effect.t
-  | DEI : ([ `Byte | `Short ] * int) -> int Effect.t
+  | DEI : int -> int Effect.t
+  | DEI2 : int -> int Effect.t
   | DEO : (int * int) -> unit Effect.t
 
 let ram (Machine { data; _ }) = data
@@ -226,7 +227,7 @@ let dispatch (Machine m) (pc : int) =
         | 0x16 (* DEI *) ->
             let port = popbyte mode stk in
             push mode stk
-              (perform (DEI ((if short then `Short else `Byte), port)))
+              (if short then perform (DEI2 port) else perform (DEI port))
         | 0x17 (* DEO *) ->
             let port = popbyte mode stk in
             let value = pop mode stk in

lib/Machine.mli

@@ -15,7 +15,8 @@ val rst : machine -> stack
 
 type _ Effect.t +=
   | BRK : int Effect.t
-  | DEI : ([ `Byte | `Short ] * int) -> int Effect.t
+  | DEI : int -> int Effect.t
+  | DEI2 : int -> int Effect.t
   | DEO : (int * int) -> unit Effect.t
 
 val create : string -> machine

lib/Varvara/File.ml

@@ -2,7 +2,7 @@ type file_state =
   | Idle
   | File_read of in_channel
   | File_write of out_channel
-  | Dir_read of Unix.dir_handle * string (* dir_handle, filepath *)
+  | Dir_read of Unix.dir_handle * string
   | Dir_write
 
 type state = {
@@ -131,7 +131,8 @@ module Make (Addr : ADDR) : Uxn.Device.DEVICE with type state = state = struct
           match state.state with
           | File_read ic -> (
               try
-                let bytes_read = input ic ram addr len in
+                let max_len = 0x10000 - addr in
+                let bytes_read = input ic ram addr (min max_len len) in
                 bytes_read
               with
               | End_of_file -> 0
@@ -140,6 +141,7 @@ module Make (Addr : ADDR) : Uxn.Device.DEVICE with type state = state = struct
               try
                 let contents = read_directory fp len in
                 let bytes_to_copy = min len (String.length contents) in
+                let bytes_to_copy = min (0x10000 - addr) bytes_to_copy in
                 Bytes.blit_string contents 0 ram addr bytes_to_copy;
                 Unix.closedir dh;
                 state.state <- Idle;
@@ -173,9 +175,10 @@ module Make (Addr : ADDR) : Uxn.Device.DEVICE with type state = state = struct
           match state.state with
           | File_write oc -> (
               try
-                output oc ram addr len;
+                let max_len = 0x10000 - addr in
+                output oc ram addr (min max_len len);
                 flush oc;
-                len
+                min max_len len
               with Sys_error _ -> 0)
           | Dir_write ->
               if Sys.file_exists filepath && Sys.is_directory filepath then 1
@@ -190,19 +193,20 @@ module Make (Addr : ADDR) : Uxn.Device.DEVICE with type state = state = struct
       | Some filepath ->
           let stat_str = format_stat filepath len in
           let bytes_to_copy = min len (String.length stat_str) in
+          let bytes_to_copy = min (0x10000 - addr) bytes_to_copy in
           Bytes.blit_string stat_str 0 ram addr bytes_to_copy;
           bytes_to_copy
 
   let file_delete () =
-    if file_not_ready () then -1
+    if file_not_ready () then 0
     else
       match state.filepath with
-      | None -> -1
+      | None -> 0
       | Some filepath -> (
           try
             Unix.unlink filepath;
-            0
+            1
-          with Unix.Unix_error _ -> -1)
+          with Unix.Unix_error _ -> 0)
 
   let file_success dev port value = Bytes.set_uint16_be dev port value
   let dei _ _ = assert false

utils/varvara.file.tal

@@ -6,81 +6,124 @@
 |100
 
 @on-reset ( -> )
-	file/<create>
-	file/<load>
-	#0004 .File/success DEI2 NEQ2 ?fail
-	;file/a1 LDA2 ;file/a2 LDA2 NEQ2 ?fail
-	;dict/load str/<print>
-	;file/b1 LDA2 ;file/b2 LDA2 NEQ2 ?fail
-	;dict/append str/<print>
-	;file/stat-buf file/<stat>
-	;file/stat-hs LDA2 LIT2 "00 NEQ2 ?fail
-	;file/stat-ls LDA2 LIT2 "04 NEQ2 ?fail
-	;dict/stat str/<print>
-	file/<delete>
-	;file/null-buf file/<stat>
-	;file/null-buf LDA2 LIT2 "!! NEQ2 ?fail
-	;dict/delete str/<print>
 	#800f DEO
-	BRK
+	;dict/write file/test-write <test>
-
+	;dict/append file/test-append <test>
-@fail ( -> )
+	;dict/read file/test-read <test>
-	;dict/failed str/<print>
+	;dict/stat file/test-stat <test>
-	#010f DEO
+	;dict/delete file/test-delete <test>
+	( | overflows )
+	;dict/write-of file/test-write-of <test>
+	;dict/read-of file/test-read-of <test>
+	;dict/stat-of file/test-stat-of <test>
+	( | cleanup )
+	;file/name .File/name DEO2
+	#01 .File/delete DEO
 	BRK
 
 (
-@|File )
+@|Tests )
 
-@file/<create> ( -- )
+@file/test-write ( -- pass )
 	;&name .File/name DEO2
 	#0002 .File/length DEO2
 	;&a1 .File/write DEO2
-	( | append )
+	.File/success DEI2 #0002 EQU2 JMP2r
+
+@file/test-append ( -- pass )
 	;&name .File/name DEO2
 	#0002 .File/length DEO2
 	#01 .File/append DEO
 	;&b1 .File/write DEO2
-	JMP2r
+	.File/success DEI2 #0002 EQU2 JMP2r
 
-@file/<load> ( -- )
+@file/test-read ( -- pass )
 	;&name .File/name DEO2
-	( two more bytes than max length ) #0006 .File/length DEO2
+	( 4+2 ) #0006 .File/length DEO2
-	;&load-buf .File/read DEO2
+	;&read-buf .File/read DEO2
-	JMP2r
+	( success ) .File/success DEI2 #0004 EQU2
+	( a ) ;&a1 LDA2 ;&a2 LDA2 EQU2 AND
+	( b ) ;&b1 LDA2 ;&b2 LDA2 EQU2 AND JMP2r
 
-@file/<stat> ( buf* -- )
+@file/test-stat ( -- pass )
 	;&name .File/name DEO2
 	#0004 .File/length DEO2
-	.File/stat DEO2
+	;&stat-buf .File/stat DEO2
-	JMP2r
+	( success ) .File/success DEI2 #0004 EQU2
+	( a ) ;&stat-hs LDA2 LIT2 "00 EQU2 AND
+	( b ) ;&stat-ls LDA2 LIT2 "04 EQU2 AND
+	( | try missing file )
+	;&unknown-name .File/name DEO2
+	#0002 .File/length DEO2
+	;&stat-buf .File/stat DEO2
+	;&stat-buf LDA2 LIT2 "!! EQU2 AND JMP2r
 
-@file/<delete> ( -- )
+@file/test-delete ( -- pass )
 	;&name .File/name DEO2
 	#01 .File/delete DEO
-	JMP2r
+	.File/success DEI2 #0001 EQU2
+	( | stat )
+	;&name .File/name DEO2
+	#0002 .File/length DEO2
+	;&null-buf .File/stat DEO2
+	;&null-buf LDA2 LIT2 "!! EQU2 AND
+	( | try failure )
+	#01 .File/delete DEO
+	.File/success DEI2 #0000 EQU2 AND JMP2r
 
-	&name "test.txt $1
+@file/test-write-of ( -- pass )
+	;&name .File/name DEO2
+	#0004 .File/length DEO2
+	#fffe .File/write DEO2
+	.File/success DEI2 #0002 EQU2 JMP2r
+
+@file/test-read-of ( -- pass )
+	;&name .File/name DEO2
+	#0002 .File/length DEO2
+	#ffff .File/read DEO2
+	.File/success DEI2 #0001 EQU2 JMP2r
+
+@file/test-stat-of ( -- pass )
+	;&name .File/name DEO2
+	#0004 .File/length DEO2
+	#fffe .File/stat DEO2
+	.File/success DEI2 #0002 EQU2 JMP2r
 
 (
-@|Utils )
+@|Helpers )
+
+@<test> ( name* f -- )
+	?{
+		str/<print>
+		#010f DEO
+		;dict/fail !str/<print> }
+	str/<print>
+	;dict/pass
+	( >> )
 
 @str/<print> ( str* -- )
 	LDAk DUP ?{ POP POP2 JMP2r }
-	#18 DEO
+	.Console/write DEO
 	INC2 !/<print>
 
 (
-@|Data )
+@|Assets )
 
-@dict/failed "File: 20 "fail 0a $1
+@dict/write "File/write: 20 $1
-	&load "File/load: 20 "pass 0a $1
+	&append "File/append: 20 $1
-	&append "File/append: 20 "pass 0a $1
+	&read "File/read: 20 $1
-	&stat "File/stat: 20 "pass 0a $1
+	&stat "File/stat: 20 $1
-	&delete "File/delete: 20 "pass 0a $1
+	&delete "File/delete: 20 $1
+	&write-of "File/write(overflow): 20 $1
+	&read-of "File/read(overflow): 20 $1
+	&stat-of "File/stat(overflow): 20 $1
+	&fail "fail 0a $1
+	&pass "pass 0a $1
 
-@file/data &a1 1234 &b1 5678
+@file/a1 1234 &b1 5678
-	( load buf ) &load-buf &a2 $2 &b2 $2
+	( read buf ) &read-buf &a2 $2 &b2 $2
 	( stat buf ) &stat-buf &stat-hs $2 &stat-ls $2
 	( null buf ) &null-buf $4
+	&name "test.txt $1
+	&unknown-name "abcdefghj $1