From 5145dd3aa0c02c9fc496d1432fc4410674206e1d Mon Sep 17 00:00:00 2001 From: Bryan Newbold Date: Mon, 20 Feb 2017 00:05:31 -0800 Subject: Import Upstream version 3a2 --- matfile.scm | 27 ++++++++++++++++++--------- 1 file changed, 18 insertions(+), 9 deletions(-) (limited to 'matfile.scm') diff --git a/matfile.scm b/matfile.scm index 2e3ff15..a7a96a6 100644 --- a/matfile.scm +++ b/matfile.scm @@ -1,5 +1,5 @@ ; "matfile.scm", Read MAT-File Format version 4 (MATLAB) -; Copyright (c) 2001, 2002, 2003 Aubrey Jaffer +; Copyright (C) 2001, 2002, 2003 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is @@ -22,6 +22,15 @@ (require 'byte-number) (require-if 'compiling 'string-case) ; string-ci->symbol used by matfile:load +(define (unwritten-stubber name) + (lambda (arg) (slib:error 'name 'not 'written "matfile.scm"))) +(define bytes->vax-d-double (unwritten-stubber 'bytes->vax-d-double)) +(define bytes->vax-g-double (unwritten-stubber 'bytes->vax-g-double)) +(define bytes->cray-double (unwritten-stubber 'bytes->cray-double)) +(define bytes->vax-d-float (unwritten-stubber 'bytes->vax-d-float)) +(define bytes->vax-g-float (unwritten-stubber 'bytes->vax-g-float)) +(define bytes->cray-float (unwritten-stubber 'bytes->cray-float)) + ;;@code{(require 'matfile)} ;;@ftindex matfile ;;@ftindex matlab @@ -102,17 +111,17 @@ (set! imagf (case imagf ((0) #f) ((1) #t))) (let ((namstr (make-string namlen)) (mat (case m-type - ((numeric) (create-array + ((numeric) (make-array (case d-prot - ((0) ((if imagf Ac64 Ar64))) - ((1) ((if imagf Ac32 Ar32))) - ((2) (As32)) - ((3) (As16)) - ((4) (Au16)) - ((5) (Au8)) + ((0) ((if imagf A:floC64b A:floR64b))) + ((1) ((if imagf A:floC32b A:floR32b))) + ((2) (A:fixZ32b)) + ((3) (A:fixZ16b)) + ((4) (A:fixN16b)) + ((5) (A:fixN8b)) (else (slib:error 'p 'type d-prot))) mrows ncols)) - ((text) (create-array "." mrows ncols)) + ((text) (make-array "." mrows ncols)) ((sparse) (slib:error 'sparse '?))))) (do ((idx 0 (+ 1 idx))) ((>= idx namlen)) -- cgit v1.2.3