diff --git a/exe/uxnemu.ml b/exe/uxnemu.ml index 9939408..f16026b 100644 --- a/exe/uxnemu.ml +++ b/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 diff --git a/lib/Machine.ml b/lib/Machine.ml index 4796104..b94d6f9 100644 --- a/lib/Machine.ml +++ b/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 diff --git a/lib/Machine.mli b/lib/Machine.mli index 81494b0..453648c 100644 --- a/lib/Machine.mli +++ b/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 diff --git a/lib/Varvara/File.ml b/lib/Varvara/File.ml index 8d23374..fcbc78a 100644 --- a/lib/Varvara/File.ml +++ b/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 - with Unix.Unix_error _ -> -1) + 1 + with Unix.Unix_error _ -> 0) let file_success dev port value = Bytes.set_uint16_be dev port value let dei _ _ = assert false diff --git a/utils/varvara.file.tal b/utils/varvara.file.tal index 1035789..1067ef9 100644 --- a/utils/varvara.file.tal +++ b/utils/varvara.file.tal @@ -6,81 +6,124 @@ |100 @on-reset ( -> ) - file/ - file/ - #0004 .File/success DEI2 NEQ2 ?fail - ;file/a1 LDA2 ;file/a2 LDA2 NEQ2 ?fail - ;dict/load str/ - ;file/b1 LDA2 ;file/b2 LDA2 NEQ2 ?fail - ;dict/append str/ - ;file/stat-buf file/ - ;file/stat-hs LDA2 LIT2 "00 NEQ2 ?fail - ;file/stat-ls LDA2 LIT2 "04 NEQ2 ?fail - ;dict/stat str/ - file/ - ;file/null-buf file/ - ;file/null-buf LDA2 LIT2 "!! NEQ2 ?fail - ;dict/delete str/ #800f DEO - BRK - -@fail ( -> ) - ;dict/failed str/ - #010f DEO + ;dict/write file/test-write + ;dict/append file/test-append + ;dict/read file/test-read + ;dict/stat file/test-stat + ;dict/delete file/test-delete + ( | overflows ) + ;dict/write-of file/test-write-of + ;dict/read-of file/test-read-of + ;dict/stat-of file/test-stat-of + ( | cleanup ) + ;file/name .File/name DEO2 + #01 .File/delete DEO BRK ( -@|File ) +@|Tests ) -@file/ ( -- ) +@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/ ( -- ) +@file/test-read ( -- pass ) ;&name .File/name DEO2 - ( two more bytes than max length ) #0006 .File/length DEO2 - ;&load-buf .File/read DEO2 - JMP2r + ( 4+2 ) #0006 .File/length DEO2 + ;&read-buf .File/read DEO2 + ( success ) .File/success DEI2 #0004 EQU2 + ( a ) ;&a1 LDA2 ;&a2 LDA2 EQU2 AND + ( b ) ;&b1 LDA2 ;&b2 LDA2 EQU2 AND JMP2r -@file/ ( buf* -- ) +@file/test-stat ( -- pass ) ;&name .File/name DEO2 #0004 .File/length DEO2 - .File/stat DEO2 - JMP2r + ;&stat-buf .File/stat DEO2 + ( 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/ ( -- ) +@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 ) + +@ ( name* f -- ) + ?{ + str/ + #010f DEO + ;dict/fail !str/ } + str/ + ;dict/pass + ( >> ) @str/ ( str* -- ) LDAk DUP ?{ POP POP2 JMP2r } - #18 DEO + .Console/write DEO INC2 !/ ( -@|Data ) +@|Assets ) -@dict/failed "File: 20 "fail 0a $1 - &load "File/load: 20 "pass 0a $1 - &append "File/append: 20 "pass 0a $1 - &stat "File/stat: 20 "pass 0a $1 - &delete "File/delete: 20 "pass 0a $1 +@dict/write "File/write: 20 $1 + &append "File/append: 20 $1 + &read "File/read: 20 $1 + &stat "File/stat: 20 $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 - ( load buf ) &load-buf &a2 $2 &b2 $2 +@file/a1 1234 &b1 5678 + ( 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