Some buffer updates

Initialising buffers from files, error checking on creation, resizing.
This commit is contained in:
Edwin Brady 2020-01-31 16:40:18 +00:00
parent e69c1529d9
commit 2465e5a149
4 changed files with 54 additions and 15 deletions

View File

@ -7,20 +7,23 @@ data Buffer : Type where
MkBuffer : AnyPtr -> (size : Int) -> (loc : Int) -> Buffer
export
newBuffer : Int -> IO Buffer
rawSize : Buffer -> IO Int
rawSize (MkBuffer buf _ _)
= schemeCall Int "blodwen-buffer-size" [buf]
export
newBuffer : Int -> IO (Maybe Buffer)
newBuffer size
= do buf <- schemeCall AnyPtr "blodwen-new-buffer" [size]
pure (MkBuffer buf size 0)
sz <- schemeCall Int "blodwen-buffer-size" [buf]
if sz == 0
then pure Nothing
else pure $ Just $ MkBuffer buf size 0
export
resetBuffer : Buffer -> Buffer
resetBuffer (MkBuffer ptr s l) = MkBuffer ptr s 0
export
rawSize : Buffer -> IO Int
rawSize (MkBuffer buf _ _)
= schemeCall Int "blodwen-buffer-size" [buf]
export
size : Buffer -> Int
size (MkBuffer _ s _) = s
@ -93,11 +96,22 @@ export
readBufferFromFile : BinaryFile -> Buffer -> (maxbytes : Int) ->
IO (Either FileError Buffer)
readBufferFromFile (FHandle h) (MkBuffer buf size loc) max
= do read <- schemeCall Int "blodwen-readbuffer" [h, buf, loc, max]
= do read <- schemeCall Int "blodwen-readbuffer-bytes" [h, buf, loc, max]
if read >= 0
then pure (Right (MkBuffer buf size (loc + read)))
else pure (Left FileReadError)
-- Create a new buffer by reading all the contents from the given file
-- Fails if no bytes can be read or buffer can't be created
export
createBufferFromFile : BinaryFile -> IO (Either FileError Buffer)
createBufferFromFile (FHandle h)
= do buf <- schemeCall AnyPtr "blodwen-readbuffer" [h]
sz <- schemeCall Int "blodwen-buffer-size" [buf]
if sz >= 0
then pure (Right (MkBuffer buf sz sz))
else pure (Left FileReadError)
export
writeBufferToFile : BinaryFile -> Buffer -> (maxbytes : Int) ->
IO (Either FileError Buffer)
@ -108,3 +122,15 @@ writeBufferToFile (FHandle h) (MkBuffer buf size loc) max
if written == max'
then pure (Right (MkBuffer buf size (loc + max')))
else pure (Left FileWriteError)
export
resizeBuffer : Buffer -> Int -> IO (Maybe Buffer)
resizeBuffer old newsize
= do Just buf <- newBuffer newsize
| Nothing => pure Nothing
-- If the new buffer is smaller than the old one, just copy what
-- fits
let oldsize = size old
let len = if newsize < oldsize then newsize else oldsize
copyData old 0 len buf 0
pure (Just buf)

View File

@ -93,10 +93,14 @@
(define (blodwen-buffer-copydata buf start len dest loc)
(bytevector-copy! buf start dest loc len))
(define (blodwen-readbuffer h buf loc max)
(define (blodwen-readbuffer-bytes h buf loc max)
(guard (x (#t -1))
(get-bytevector-n! h buf loc max)))
(define (blodwen-readbuffer h)
(guard (x (#t (bytevector)))
(get-bytevector-all h)))
(define (blodwen-writebuffer h buf loc max)
(guard (x (#t -1))
(put-bytevector h buf loc max)
@ -152,6 +156,9 @@
(string-append str "\n"))
""))
(define (blodwen-file-size p)
(port-length p))
(define (blodwen-eof p)
(if (port-eof? p)
1

View File

@ -11,7 +11,7 @@
(define blodwen-shl (lambda (x y) (arithmetic-shift x y)))
(define blodwen-shr (lambda (x y) (arithmetic-shift x (- y))))
(define blodwen-and (lambda (x y) (bitwise-and x y)))
(define blodwen-or (lambda (x y) (bitwise-or x y)))
(define blodwen-or (lambda (x y) (bitwise-ior x y)))
(define blodwen-xor (lambda (x y) (bitwise-xor x y)))
(define cast-num
@ -93,11 +93,16 @@
(define (blodwen-buffer-copydata buf start len dest loc)
(bytevector-copy! buf start dest loc len))
(define (blodwen-readbuffer h buf loc max)
(define (blodwen-readbuffer-bytes h buf loc max)
(with-handlers
([(lambda (x) #t) (lambda (exn) -1)])
(get-bytevector-n! h buf loc max)))
(define (blodwen-readbuffer h)
(with-handlers
([(lambda (x) #t) (lambda (exn) (make-bytevector 0))])
(get-bytevector-all h)))
(define (blodwen-writebuffer h buf loc max)
(with-handlers
([(lambda (x) #t) (lambda (exn) -1)])

View File

@ -3,7 +3,8 @@ import System.File
main : IO ()
main
= do buf <- newBuffer 100
= do Just buf <- newBuffer 100
| Nothing => putStrLn "Buffer creation failed"
s <- rawSize buf
printLn s
@ -34,8 +35,7 @@ main
Right f <- openBinaryFile "test.buf" Read
| Left err => putStrLn "File error on read"
buf2 <- newBuffer 100
Right _ <- readBufferFromFile f buf2 100
Right buf2 <- createBufferFromFile f
| Left err => do putStrLn "Buffer read fail"
closeFile f
closeFile f
@ -45,7 +45,8 @@ main
Right f <- openBinaryFile "test.buf" Read
| Left err => putStrLn "File error on read"
buf3 <- newBuffer 99
Just buf3 <- newBuffer 99
| Nothing => putStrLn "Buffer creation failed"
Right _ <- readBufferFromFile f buf3 100
| Left err => do putStrLn "Buffer read fail"
closeFile f