source: project/release/5/string-utils/trunk/string-hexadecimal.scm @ 39995

Last change on this file since 39995 was 39995, checked in by Kon Lovett, 2 months ago

check for buffer overflow (module was supposed to be unsafe but bad idea), add test

File size: 2.7 KB
Line 
1;;;; string-hexadecimal.scm  -*- Scheme -*-
2;;;; Kon Lovett, Jul '18
3;;;; Kon Lovett, Aug '17
4;;;; Kon Lovett, Aug '10
5
6(declare
7  (bound-to-procedure ##sys#signal-hook ##sys#make-string))
8
9(module string-hexadecimal
10
11(;export
12  string->hex *string->hex
13  hex->string *hex->string)
14
15(import scheme)
16(import (chicken base))
17(import (chicken type))
18(import (chicken foreign))
19(import (chicken memory representation))
20(import to-hex)
21(import (only type-checks check-natural-fixnum check-string))
22
23;;
24
25(: string->hex (string #!optional fixnum (or boolean fixnum) --> string))
26(: hex->string (string #!optional fixnum --> string))
27(: *string->hex (string fixnum fixnum --> string))
28(: *hex->string (string fixnum fixnum --> string))
29
30;;
31
32(define (check-subvector-indexes loc start end)
33  (unless
34    (<=
35      (check-natural-fixnum loc start 'start)
36      (check-natural-fixnum loc end 'end))
37    (##sys#signal-hook #:bounds-error loc "illegal subvector specification" start end) ) )
38
39;;
40
41(define (string->hex str #!optional (start 0) (end #f))
42  (let* (
43    (len (number-of-bytes (check-string 'string->hex str)))
44    (end (or end len)) )
45    (check-subvector-indexes 'string->hex start end)
46    (*string->hex str start end) ) )
47
48(define (hex->string str #!optional (start 0) (end #f))
49  (let* (
50    (len (number-of-bytes (check-string 'hex->string str)))
51    (end (or end len)) )
52    (unless (zero? (modulo end 2))
53      (error 'hex->string "too few characters" str) )
54    (check-subvector-indexes 'hex->string start end)
55    (*hex->string str start end) ) )
56
57;;
58
59(define (*string->hex str start end)
60  (let (
61    (len (- end start)) )
62    (if (zero? len)
63      ""
64      (str_to_hex (##sys#make-string (* len 2)) str start len) ) ) )
65
66(define (*hex->string str start end)
67  (let (
68    (len (- end start)) )
69    (if (zero? len)
70      ""
71      (hex_to_str (##sys#make-string (quotient len 2)) str start len) ) ) )
72
73#|
74(import
75  (only (srfi 1) drop drop-right)
76  (only (srfi 13) string-pad string-concatenate  reverse-list->string))
77
78(define ( ch)
79  (string-pad (number->string (char->integer ch) 16) 2 #\0) )
80
81(define (*string->hex str start end)
82  (let* (
83    (ls (string->list str))
84    (ls (drop ls start))
85    (strlen (string-length str))
86    (ls (drop-right ls (- strlen end))) )
87    (string-concatenate
88      (map
89        (lambda (c)
90          (string-pad (number->string (char->integer c) 16) 2 #\0))
91      ls)) ) )
92
93(define (*hex->string str)
94  (let (
95    (len (string-length str)) )
96    (let loop ((i 0) (ls '()))
97      (if (<= len i)
98        (reverse-list->string ls)
99        (let (
100          (ni (+ i 2)) )
101          (loop ni (cons (integer->char (string->number (substring str i ni) 16)) ls)) ) ) ) ) )
102|#
103
104) ;module string-hexadecimal
Note: See TracBrowser for help on using the repository browser.