revise File device according to new tests
This commit is contained in:
parent
cf31dc5564
commit
35b0a4f6dd
5 changed files with 106 additions and 57 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
@fail ( -> )
|
||||
;dict/failed str/<print>
|
||||
#010f DEO
|
||||
;dict/write file/test-write <test>
|
||||
;dict/append file/test-append <test>
|
||||
;dict/read file/test-read <test>
|
||||
;dict/stat file/test-stat <test>
|
||||
;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
|
||||
;&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/<stat> ( 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/<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
|
||||
&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
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue