listname->symbol, ltos fix

i.c

@@ -1597,8 +1597,10 @@ define_instruction(ltos) {
   obj l = ac; int n = 0, i, *d;
   while (is_pair(l)) { l = pair_cdr(l); ++n; }
   d = allocstring(n, ' ');
-  for (i = 0; i < n; ac = pair_cdr(ac), ++i)
-    sdatachars(d)[i] = get_char(pair_car(ac));
+  for (i = 0; i < n; ac = pair_cdr(ac), ++i) {
+    obj x = pair_car(ac); ckc(x);
+    sdatachars(d)[i] = get_char(x);
+  }
   ac = string_obj(d);
   gonexti();
 }

src/t.scm

@@ -1262,6 +1262,37 @@
 ; Library names and library file lookup
 ;---------------------------------------------------------------------------------------------
 
+(define (listname->symbol lib)
+  (define postfix "/")
+  (define prefix "")
+  (define commons '(#\- #\< #\= #\>))
+  (define symbol-prefix "/")
+  (define number-prefix ".")
+  (define (mangle-symbol sym)
+    (let loop ([lst (string->list (symbol->string sym))] [text '()])
+      (cond [(null? lst) 
+             (list->string (reverse text))]
+            [(or (char-alphabetic? (car lst)) (char-numeric? (car lst)))
+             (loop (cdr lst) (cons (car lst) text))]
+            [(memv (car lst) commons)
+             (loop (cdr lst) (cons (car lst) text))]
+            [else
+             (let* ([s (number->string (char->integer (car lst)) 16)]
+                    [s (if (< (string-length s) 2) (string-append "0" s) s)]
+                    [l (cons #\% (string->list (string-upcase s)))])
+               (loop (cdr lst) (append (reverse l) text)))])))
+  (define (mangle-number num)
+    (number->string num))
+  (unless (list? lib) (x-error "invalid library name" lib))
+  (let loop ([lst lib] [parts (list prefix)])
+    (if (null? lst)
+        (string->symbol (apply string-append (reverse (cons postfix parts))))
+        (cond [(symbol? (car lst))
+               (loop (cdr lst) (cons (mangle-symbol (car lst)) (cons symbol-prefix parts)))]
+              [(exact-integer? (car lst))
+               (loop (cdr lst) (cons (mangle-number (car lst)) (cons number-prefix parts)))]
+              [else (x-error "invalid library name" lib)]))))
+
 (define (listname-segment->string s)
   (cond [(symbol? s) (symbol->string s)]
         [(number? s) (number->string s)]

t.c

@@ -647,6 +647,18 @@ char *t_code[] = {
   "(y14:path-directory)[01},.2,@(y34:file-resolve-relative-to-base-path)["
   "22}.1]2}.0]1",
 
+  "P", "listname->symbol",
+  "%1,,,,,,,#0#1#2#3#4#5#6'(s1:/).!0'(s0:).!1'(l4:c-;c<;c=;c>;).!2'(s1:/)"
+  ".!3'(s1:.).!4.2,&1{%1n,.1X4X2,,#0.0,:0,&2{%2.0u?{.1A8X3]2}.0aC4,.0?{.0"
+  "}{.1aC5}_1?{.1,.1ac,.1d,:1^[22}:0^,.1aA1?{.1,.1ac,.1d,:1^[22}'(i16),.1"
+  "aX8E8,'2,.1S3<?{.0,'(s1:0)S6}{.0},.0SuX2,'(c%25)c,.4,.1A8L6,.4d,:1^[52"
+  "}.!0.0^_1[12}.!5&0{%1'(i10),.1E8]1}.!6.7L0~?{${.9,'(s20:invalid librar"
+  "y name),@(y7:x-error)[02}}.1^,l1,.8,,#0.(i10),.1,.9,.(i12),.(i10),.(i1"
+  "3),.9,&7{%2.0u?{${.3,:0^cA8,@(y14:%25string-append),@(y13:apply-to-lis"
+  "t)[02}X5]2}.0aY0?{.1,:2^c,${.3a,:1^[01}c,.1d,:5^[22}.0aI0?{.1,:4^c,${."
+  "3a,:3^[01}c,.1d,:5^[22}:6,'(s20:invalid library name),@(y7:x-error)[22"
+  "}.!0.0^_1[82",
+
   "P", "listname-segment->string",
   "%1.0Y0?{.0X4]1}.0N0?{'(i10),.1E8]1}.0S0?{.0]1}.0,'(s34:invalid symboli"
   "c file name element),@(y7:c-error)[12",