lassik
/
scheme
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Add exclamation marks to poke procedure names

This commit is contained in:
Lassi Kortela 2019-06-23 11:56:21 +03:00
parent 4d5ef562cb
commit ca6d55e54c
1 changed files with 13 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
trivial-tar-writer.scm
View File

@ -4,13 +4,13 @@
(define nulls (make-bytevector 512 0)) (define nulls (make-bytevector 512 0))
(define zeros (make-bytevector 12 (char->integer #\0))) (define zeros (make-bytevector 12 (char->integer #\0)))
(define (tar-poke-string header at nbyte string) (define (tar-poke-string! header at nbyte string)
(let* ((bytes (string->utf8 string)) (let* ((bytes (string->utf8 string))
(nnull (- nbyte (bytevector-length bytes)))) (nnull (- nbyte (bytevector-length bytes))))
(when (< nnull 0) (error "tar: string too long")) (when (< nnull 0) (error "tar: string too long"))
(bytevector-copy! header at bytes))) (bytevector-copy! header at bytes)))
(define (tar-poke-octal header at nbyte number) (define (tar-poke-octal! header at nbyte number)
(unless (integer? number) (error "tar: not an integer")) (unless (integer? number) (error "tar: not an integer"))
(when (< number 0) (error "tar: negative integer")) (when (< number 0) (error "tar: negative integer"))
(let* ((bytes (string->utf8 (number->string number 8))) (let* ((bytes (string->utf8 (number->string number 8)))
@ -32,19 +32,19 @@
(nbyte (bytevector-length bytes)) (nbyte (bytevector-length bytes))
(nnull (- 512 (truncate-remainder nbyte 512))) (nnull (- 512 (truncate-remainder nbyte 512)))
(unix-time-now 0)) (unix-time-now 0))
(tar-poke-string header 0 100 fake-path) (tar-poke-string! header 0 100 fake-path)
(tar-poke-octal header 100 8 #o644) (tar-poke-octal! header 100 8 #o644)
(tar-poke-octal header 108 8 0) (tar-poke-octal! header 108 8 0)
(tar-poke-octal header 116 8 0) (tar-poke-octal! header 116 8 0)
(tar-poke-octal header 124 12 nbyte) (tar-poke-octal! header 124 12 nbyte)
(tar-poke-octal header 136 12 unix-time-now) (tar-poke-octal! header 136 12 unix-time-now)
(bytevector-copy! header 148 (make-bytevector 8 (char->integer #\space))) (bytevector-copy! header 148 (make-bytevector 8 (char->integer #\space)))
(bytevector-u8-set! header 156 (char->integer #\0)) (bytevector-u8-set! header 156 (char->integer #\0))
(tar-poke-string header 157 100 "") (tar-poke-string! header 157 100 "")
(tar-poke-string header 257 8 "ustar ") (tar-poke-string! header 257 8 "ustar ")
(tar-poke-string header 265 32 "root") (tar-poke-string! header 265 32 "root")
(tar-poke-string header 297 32 "root") (tar-poke-string! header 297 32 "root")
(tar-poke-octal header 148 7 (tar-header-checksum header)) (tar-poke-octal! header 148 7 (tar-header-checksum header))
(write-bytevector header) (write-bytevector header)
(write-bytevector bytes) (write-bytevector bytes)
(write-bytevector nulls (current-output-port) 0 nnull))) (write-bytevector nulls (current-output-port) 0 nnull)))