Changeset 27394 in project
- Timestamp:
- 09/09/12 00:34:59 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
release/4/endian-port/trunk/endian-port.scm
r26451 r27394 1 1 2 2 ;; 3 3 ;; An I/O port that supports different endian formats. … … 22 22 23 23 (module endian-port 24 (make-endian-port 24 (make-endian-port 25 25 endian-port? 26 endian-port-fileno 27 endian-port-filename 26 endian-port-fileno 27 endian-port-filename 28 28 endian-port-byte-order 29 29 close-endian-port 30 30 open-endian-port 31 port->endian-port 32 endian-port-set-bigendian! 33 endian-port-set-littlendian! 31 port->endian-port 32 endian-port-set-bigendian! 33 endian-port-set-littlendian! 34 34 endian-port-setpos 35 endian-port-pos 36 endian-port-eof? 35 endian-port-pos 36 endian-port-eof? 37 37 endian-port-read-int1 38 38 endian-port-read-int2 … … 45 45 endian-port-read-bit-vector 46 46 endian-port-read-byte-vector 47 endian-port-write-int1 47 endian-port-write-int1 48 48 endian-port-write-int2 49 49 endian-port-write-int4 50 endian-port-write-uint1 50 endian-port-write-uint1 51 51 endian-port-write-uint2 52 52 endian-port-write-uint4 53 endian-port-write-ieee-float32 53 endian-port-write-ieee-float32 54 54 endian-port-write-ieee-float64 55 55 endian-port-write-bit-vector … … 68 68 ; * fileno: file handle corresponding to the port 69 69 ; * filename: file name corresponding to the port 70 ; * byte-order: can be MSB or LSB (type defined in unit endian-blob) 70 ; * byte-order: can be MSB or LSB (type defined in unit endian-blob) 71 71 ; 72 72 … … 85 85 86 86 87 ; Procedure: 87 ; Procedure: 88 88 ; close-endian-port:: ENDIAN-PORT -> UNDEFINED 89 89 ; … … 93 93 (file-close (endian-port-fileno eport))) 94 94 95 ; Procedure: 95 ; Procedure: 96 96 ; open-endian-port MODE FILENAME -> ENDIAN-PORT 97 97 ; … … 107 107 (error 'endian-port "unable to open file: " filename) 108 108 (make-endian-port fd filename MSB)))) 109 (else 109 (else 110 110 (let ((fd (file-open filename (bitwise-ior open/append open/creat open/binary)))) 111 111 (if (< fd 0) … … 113 113 (make-endian-port fd filename MSB)))))) 114 114 115 ; Procedure: 115 ; Procedure: 116 116 ; port->endian-port:: PORT -> ENDIAN-PORT 117 117 ; 118 118 ; Creates an endian port to the file specified by the given port. The 119 ; default endianness of the newly created endian port is MSB. 119 ; default endianness of the newly created endian port is MSB. 120 120 ; 121 121 (define (port->endian-port port) … … 152 152 (set-file-position! (endian-port-fileno eport) pos seek/set)) 153 153 (else (set-file-position! (endian-port-fileno eport) pos whence))))) 154 154 155 155 156 156 ; Procedure: … … 162 162 (define (endian-port-pos eport) 163 163 (file-position (endian-port-fileno eport))) 164 164 165 165 166 166 ; Procedure: … … 173 173 (zero? (- (file-size (endian-port-fileno eport)) 174 174 (file-position (endian-port-fileno eport))))) 175 175 176 176 177 177 ; Procedure: … … 181 181 ; BYTE-ORDER is one of MSB or LSB. If byte order is not specified, 182 182 ; then use the byte order setting of the given endian port. 183 ; 183 ; 184 184 (define (endian-port-read-uint1 eport . rest) 185 185 (let-optionals rest ([byte-order (endian-port-byte-order eport)]) 186 186 (let* ( [buf (make-blob 1)] 187 187 [ret (file-read (endian-port-fileno eport) 1 buf)]) 188 (and (= (cadr ret) 1) (endian-blob->uint1 (byte-blob->endian-blob 188 (and (= (cadr ret) 1) (endian-blob->uint1 (byte-blob->endian-blob 189 189 (blob->byte-blob (car ret)) byte-order) ) )))) 190 190 191 191 192 192 ; Procedure: 193 ; endian-port-read-uint2:: EPORT [* BYTE-ORDER] -> UINTEGER. 193 ; endian-port-read-uint2:: EPORT [* BYTE-ORDER] -> UINTEGER. 194 194 ; 195 195 ; Reads an unsigned integer of size 2 bytes. Optional argument 196 196 ; BYTE-ORDER is one of MSB or LSB. If byte order is not specified, 197 197 ; then use the byte order setting of the given endian port. 198 ; 198 ; 199 199 (define (endian-port-read-uint2 eport . rest) 200 200 (let-optionals rest ([byte-order (endian-port-byte-order eport)]) 201 201 (let* ( [buf (make-blob 2)] 202 202 [ret (file-read (endian-port-fileno eport) 2 buf)]) 203 (and (= (cadr ret) 2) (endian-blob->uint2 (byte-blob->endian-blob 203 (and (= (cadr ret) 2) (endian-blob->uint2 (byte-blob->endian-blob 204 204 (blob->byte-blob (car ret)) byte-order) ) )))) 205 205 … … 211 211 ; BYTE-ORDER is one of MSB or LSB. If byte order is not specified, 212 212 ; then use the byte order setting of the given endian port. 213 ; 213 ; 214 214 (define (endian-port-read-uint4 eport . rest) 215 215 (let-optionals rest ([byte-order (endian-port-byte-order eport)]) 216 216 (let* ( [buf (make-blob 4)] 217 217 [ret (file-read (endian-port-fileno eport) 4 buf)]) 218 (and (= (cadr ret) 4) (endian-blob->uint4 (byte-blob->endian-blob 218 (and (= (cadr ret) 4) (endian-blob->uint4 (byte-blob->endian-blob 219 219 (blob->byte-blob (car ret)) byte-order) ) )))) 220 220 … … 225 225 ; BYTE-ORDER is one of MSB or LSB. If byte order is not specified, 226 226 ; then use the byte order setting of the given endian port. 227 ; 227 ; 228 228 (define (endian-port-read-int1 eport . rest) 229 229 (let-optionals rest ([byte-order (endian-port-byte-order eport)]) 230 230 (let* ( [buf (make-blob 1)] 231 231 [ret (file-read (endian-port-fileno eport) 1 buf)]) 232 (and (= (cadr ret) 1) (endian-blob->sint1 (byte-blob->endian-blob 232 (and (= (cadr ret) 1) (endian-blob->sint1 (byte-blob->endian-blob 233 233 (blob->byte-blob (car ret)) byte-order) ) )))) 234 234 235 235 236 236 ; Procedure: 237 ; endian-port-read-int2:: EPORT [* BYTE-ORDER] -> INTEGER. 237 ; endian-port-read-int2:: EPORT [* BYTE-ORDER] -> INTEGER. 238 238 ; 239 239 ; Reads a signed integer of size 2 bytes. Optional argument 240 240 ; BYTE-ORDER is one of MSB or LSB. If byte order is not specified, 241 241 ; then use the byte order setting of the given endian port. 242 ; 242 ; 243 243 (define (endian-port-read-int2 eport . rest) 244 244 (let-optionals rest ([byte-order (endian-port-byte-order eport)]) 245 245 (let* ( [buf (make-blob 2)] 246 246 [ret (file-read (endian-port-fileno eport) 2 buf)]) 247 (and (= (cadr ret) 2) (endian-blob->sint2 (byte-blob->endian-blob 247 (and (= (cadr ret) 2) (endian-blob->sint2 (byte-blob->endian-blob 248 248 (blob->byte-blob (car ret)) byte-order) ) )))) 249 249 … … 255 255 ; BYTE-ORDER is one of MSB or LSB. If byte order is not specified, 256 256 ; then use the byte order setting of the given endian port. 257 ; 257 ; 258 258 (define (endian-port-read-int4 eport . rest) 259 259 (let-optionals rest ([byte-order (endian-port-byte-order eport)]) 260 260 (let* ( [buf (make-blob 4)] 261 261 [ret (file-read (endian-port-fileno eport) 4 buf)]) 262 (and (= (cadr ret) 4) (endian-blob->sint4 (byte-blob->endian-blob 262 (and (= (cadr ret) 4) (endian-blob->sint4 (byte-blob->endian-blob 263 263 (blob->byte-blob (car ret)) byte-order) ) )))) 264 264 265 ; Procedure: 265 ; Procedure: 266 266 ; 267 267 ; endian-port-read-ieee-float32:: EPORT [* BYTE-ORDER] -> REAL … … 270 270 ; argument BYTE-ORDER is one of MSB or LSB. If byte order is not 271 271 ; specified, then use the byte order setting of the given endian port. 272 ; 272 ; 273 273 (define (endian-port-read-ieee-float32 eport . rest) 274 274 (let-optionals rest ([byte-order (endian-port-byte-order eport)]) 275 275 (let* ( [buf (make-blob 4)] 276 276 [ret (file-read (endian-port-fileno eport) 4 buf)]) 277 (and (= (cadr ret) 4) 278 (endian-blob->ieee_float32 279 (byte-blob->endian-blob 277 (and (= (cadr ret) 4) 278 (endian-blob->ieee_float32 279 (byte-blob->endian-blob 280 280 (blob->byte-blob (car ret)) byte-order) ) )))) 281 281 282 ; Procedure: 282 ; Procedure: 283 283 ; 284 284 ; endian-port-read-ieee-float32:: EPORT [* BYTE-ORDER] -> REAL … … 287 287 ; argument BYTE-ORDER is one of MSB or LSB. If byte order is not 288 288 ; specified, then use the byte order setting of the given endian port. 289 ; 289 ; 290 290 (define (endian-port-read-ieee-float64 eport . rest) 291 291 (let-optionals rest ([byte-order (endian-port-byte-order eport)]) 292 292 (let* ( [buf (make-blob 8)] 293 293 [ret (file-read (endian-port-fileno eport) 8 buf)] ) 294 (and (= (cadr ret) 8) 294 (and (= (cadr ret) 8) 295 295 (endian-blob->ieee_float64 296 296 (byte-blob->endian-blob … … 302 302 ; 303 303 ; Helper function for endian-port-read-bit-vector below 304 ; * set len bits in vector bv starting at position pos, 304 ; * set len bits in vector bv starting at position pos, 305 305 ; according to the bits set in vector b 306 306 ; … … 327 327 (let ((nb (inexact->exact (ceiling (/ size 8)))) 328 328 (bv (make-bit-vector size)) 329 (byte-order (if byte-order byte-order (endian-port-byte-order eport)))) 330 (cond 329 (byte-order (if byte-order byte-order (endian-port-byte-order eport)))) 330 (cond 331 331 ((eq? byte-order MSB) 332 332 ;; if big engian, we start with the most significant bit … … 356 356 (- rem 8)))))))))) 357 357 358 ; Procedure: 358 ; Procedure: 359 359 ; endian-port-read-byte-vector:: PORT * SIZE [* BYTE-ORDER] -> BYTE-VECTOR 360 360 ; … … 385 385 ; MSB or LSB. If byte order is not specified, then use the byte 386 386 ; order setting of the given endian port. 387 ; 387 ; 388 388 (define (endian-port-write-uint1 eport word . rest) 389 389 (let-optionals rest ([byte-order (endian-port-byte-order eport)]) … … 398 398 ; MSB or LSB. If byte order is not specified, then use the byte 399 399 ; order setting of the given endian port. 400 ; 400 ; 401 401 (define (endian-port-write-uint2 eport word . rest) 402 402 (let-optionals rest ([byte-order (endian-port-byte-order eport)]) … … 411 411 ; MSB or LSB. If byte order is not specified, then use the byte 412 412 ; order setting of the given endian port. 413 ; 413 ; 414 414 (define (endian-port-write-uint4 eport word . rest) 415 415 (let-optionals rest ([byte-order (endian-port-byte-order eport)]) … … 425 425 ; MSB or LSB. If byte order is not specified, then use the byte 426 426 ; order setting of the given endian port. 427 ; 427 ; 428 428 (define (endian-port-write-int1 eport word . rest) 429 429 (let-optionals rest ([byte-order (endian-port-byte-order eport)]) … … 438 438 ; MSB or LSB. If byte order is not specified, then use the byte 439 439 ; order setting of the given endian port. 440 ; 440 ; 441 441 (define (endian-port-write-int2 eport word . rest) 442 442 (let-optionals rest ([byte-order (endian-port-byte-order eport)]) … … 451 451 ; MSB or LSB. If byte order is not specified, then use the byte 452 452 ; order setting of the given endian port. 453 ; 453 ; 454 454 (define (endian-port-write-int4 eport word . rest) 455 455 (let-optionals rest ([byte-order (endian-port-byte-order eport)]) … … 464 464 ; is one of MSB or LSB. If byte order is not specified, then use 465 465 ; the byte order setting of the given endian port. 466 ; 466 ; 467 467 (define (endian-port-write-ieee-float32 eport word . rest) 468 468 (let-optionals rest ([byte-order (endian-port-byte-order eport)]) … … 479 479 ; is one of MSB or LSB. If byte order is not specified, then use 480 480 ; the byte order setting of the given endian port. 481 ; 481 ; 482 482 (define (endian-port-write-ieee-float64 eport word . rest) 483 483 (let-optionals rest ([byte-order (endian-port-byte-order eport)]) 484 484 (let* ( [buf (u8vector->blob (endian-blob->u8vector (ieee_float64->endian-blob word byte-order)))]) 485 485 ;(printf "trying to write float ~a, but after conversions it turns out as ~a~%" word 486 ; (endian-blob->ieee_float64 (byte-blob->endian-blob (blob->byte-blob buf) byte-order) ) 486 ; (endian-blob->ieee_float64 (byte-blob->endian-blob (blob->byte-blob buf) byte-order) ) 487 487 (file-write (endian-port-fileno eport) buf)))) 488 488 … … 521 521 ; module. Optional argument BIT-ORDER is one of MSB or LSB. If 522 522 ; bit order is not specified, then use the byte order setting of the 523 ; given endian port. 523 ; given endian port. 524 524 ; 525 525 ; Note that here the "byte order" type is interpreted as bit order:
Note: See TracChangeset
for help on using the changeset viewer.