[Ecls-list] Runtime bug in compiled code

Thu Sep 18 07:42:02 UTC 2014

ECL version: GIT of sometime in July, 2014
Platform: Windows 8.1, MSVC 2010 compiler, EMACS 24.3, SLIME 2014-8-1

The following code converts SRT subtitle file to SAMI format.
It works when eval'ed as is in the REPL or C-x C-e.
However, when (compile 'baz), it gives STORAGE-EXHAUSTED error
and stops.

(defun baz (f &key (format :iso-8859-1) (left 29) (right 29) (size 24) (align :center) (font "Meiryo") (weight :bold) (color :white) &aux p)
  (labels ((tr (c &aux (b (char-code c)))
      (if (< b 128) c (format nil "&#x~x;" b)))
    (tx (s)
      (setq s (mapcar (lambda (s) (format nil "~{~a~}" (map 'list #'tr s))) s))
      (apply
       #'concatenate 'string
       (mapl (lambda (s) (if (cdr s) (rplacd s (push "<br>" (cdr s))))) s)))
    (foo (x) (if x (+ (car x) (* 60 (foo (cdr x)))) 0))
    (ms (s) (round (foo (reverse (read-from-string s))) 1/1000))
    (bar (r &aux b e x)
      (setq r (cdr (reverse r)))
      (setq x (tx (cdr r)))
      (setq b (substitute #\space #\: (car r)))
      (setq b (substitute #\. #\, b))
      (setq e (format nil "(~a)" (subseq b (1+ (position #\> b)))))
      (setq b (format nil "(~a)" (subseq b 0 (position #\- b))))
      (format nil "<SYNC START=~a>~%<P CLASS=SUBTTL>~a~%<SYNC START=~a>~%" (ms b) x (ms e))))
    (with-open-file (s (format nil "../../desktop/~a.srt" f))
      (setf (stream-external-format s) format)
      (do ((l (read-line s) (read-line s nil))) ((not l) (setq p (reverse p)))
 (do ((m l (read-line s nil)) q)
     ((zerop (length m)) (if q (push (bar q) p)))
   (push m q)))))
  (push (format nil "<SAMI>~%<HEAD>~%<STYLE TYPE=\"Text/css\">~%<!--~%P {margin-left: ~dpt; margin-right: ~dpt; font-size: ~dpt; text-align: ~a; font-family: ~a; font-weight: ~a; color: #FFFFFF; background-color: #000000;}~%.SUBTTL {Name: 'Subtitles'; Lang: ja; SAMIType: CC;}~%-->~%</STYLE>~%</HEAD>~%<BODY>~%" left right size align font weight color) p)
  (rplacd (last p) (list (format nil "</BODY>~%</SAMI>~%")))
  ;;(rplacd (cdddr p) nil)
  (with-open-file (s (format nil "../../desktop/~a.smi" f) :direction :output)
    ;;(setf (stream-external-format s) '(:utf-8 :crlf))
    (format s "~{~a~}" p)))

Sent from Windows Mail
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/ecl-devel/attachments/20140918/f2efae92/attachment.html>