[lisplab-cvs] r198 - in trunk/src: io test

Jørn Inge Vestgården jivestgarden at common-lisp.net
Sat Dec 4 21:29:44 UTC 2010


Author: jivestgarden
Date: Sat Dec  4 16:29:44 2010
New Revision: 198

Log:
changed save format

Added:
   trunk/src/test/mat2txt.c
Modified:
   trunk/src/io/saveload.lisp

Modified: trunk/src/io/saveload.lisp
==============================================================================
--- trunk/src/io/saveload.lisp	(original)
+++ trunk/src/io/saveload.lisp	Sat Dec  4 16:29:44 2010
@@ -101,6 +101,29 @@
 	  (ash (aref a (+ off 6)) 8)
 	  (aref a (+ off 7))))
 
+(defun encode-ui64le (a i off)
+  "Writes eight bytes to the byte array in little endian format."
+  (setf (aref a (+ off 0)) (ldb '(8 . 0) i)
+	(aref a (+ off 1)) (ldb '(8 . 8) i)
+	(aref a (+ off 2)) (ldb '(8 . 16) i)
+	(aref a (+ off 3)) (ldb '(8 . 24) i)
+	(aref a (+ off 4)) (ldb '(8 . 32) i)
+	(aref a (+ off 5)) (ldb '(8 . 40) i)
+	(aref a (+ off 6)) (ldb '(8 . 48) i)
+	(aref a (+ off 7)) (ldb '(8 . 56) i)))
+
+(defun decode-ui64le (a off)
+  "Reads a eight byte integer from the byte array in little endian format."  
+  (logior (aref a (+ off 0)) 
+	  (ash (aref a (+ off 1)) 8)
+	  (ash (aref a (+ off 2)) 16)
+	  (ash (aref a (+ off 3)) 24)
+	  (ash (aref a (+ off 4)) 32)
+	  (ash (aref a (+ off 5)) 40)
+	  (ash (aref a (+ off 6)) 48)
+	  (ash (aref a (+ off 7)) 56)))
+
+
 (defun read-ui32 (stream)
   (let ((x (make-array 4 :element-type 'unsigned-byte)))
     (read-sequence x stream)
@@ -110,7 +133,9 @@
 
 (define-constant +lisplab-dump-nonce+ 154777230)
 
-(define-constant +lisplab-dump-dge+ 1025)
+;; I choos a very stupid number for the type,
+;; just because there is no systematics yet.
+(define-constant +lisplab-dump-dge+ 10000042) 
 
 (defun encode-dge-hdr (rows cols)
   ;; nonce type skip .... rows cols 
@@ -126,7 +151,7 @@
   (let* ((len (length x))
 	 (a (make-array (* 8 len) :element-type 'unsigned-byte)))
     (dotimes (i len)
-      (encode-ui64 a (ieee-floats:encode-float64 (aref x i)) (* i 8)))
+      (encode-ui64le a (ieee-floats:encode-float64 (aref x i)) (* i 8)))
     a))
     
 (defmethod msave ((s stream) (a matrix-base-dge))
@@ -154,7 +179,7 @@
 	      (read-sequence data stream)
 	      (dotimes (i len)
 		(setf (aref store i) (ieee-floats:decode-float64 
-				      (decode-ui64 data (* 8 i)))))
+				      (decode-ui64le data (* 8 i)))))
 	      (make-instance 'matrix-dge :dim (list rows cols) :store store  ))))))
 
   
\ No newline at end of file

Added: trunk/src/test/mat2txt.c
==============================================================================
--- (empty file)
+++ trunk/src/test/mat2txt.c	Sat Dec  4 16:29:44 2010
@@ -0,0 +1,69 @@
+/* A utility that converts binary matrix files to text files,
+ * i.e., files stored with lisplabs msave.
+ *
+ * This file should never be needed, but it gives 
+ * some extra data safety to have to independent 
+ * implementations of the same file protocol 
+ * 
+ * This file is in the public domain 
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <arpa/inet.h>
+#include <assert.h>
+
+unsigned read_ui32 (FILE *f) {
+  unsigned buf;
+  fread(&buf, 1, 4, f);
+  return ntohl(buf);
+}
+
+double read_f64 (FILE *f) {
+  double x;
+  fread(&x, 8, 1, f);
+  return x;
+}
+
+int main (int argn, char *arg[]) {
+  FILE *f = NULL;
+  FILE *out = stdout;
+  unsigned rows = 0;
+  unsigned cols=0;
+  int i=-1,j=-1;
+  int hdr_len=-1;
+  double x = -1.0;
+
+  if (argn == 1) {
+    printf("usage: %s binary_file [text_file]\n", arg[0]);
+    exit(1);
+  }
+  
+  f = fopen(arg[1],"r");
+  assert(f);
+  assert(read_ui32 (f) == 154777230);
+  assert(read_ui32 (f) == 10000042);
+  hdr_len = read_ui32(f);
+  for (i = 0; i < hdr_len; i++) getc(f);
+  
+  rows = read_ui32 (f);
+  cols = read_ui32 (f);
+  
+  if (argn > 2) {
+    out = fopen(arg[2],"w");
+    assert(out);
+  }
+
+  for (i = 0; i < rows; i++) {
+    for (j = 0; j < cols; j++) {
+      fprintf(out,"%.14g ", read_f64(f));
+    }
+    if (i < rows - 1)
+      fprintf(out,"\n");
+  }
+  if (argn > 2)
+    fclose(out);
+
+  fclose(f);
+  return 0;
+}




More information about the lisplab-cvs mailing list