- (complete-group-count (truncate string-length 3))
- (remainder (nth-value 1 (truncate string-length 3)))
- (padded-length (* 4 (truncate (+ string-length 2) 3)))
- (num-lines (if (plusp columns)
- (truncate (+ padded-length (1- columns)) columns)
- 0))
- (num-breaks (if (plusp num-lines)
- (1- num-lines)
- 0))
- (strlen (if stream
- 0
- (+ padded-length num-breaks)))
- (result (make-string strlen))
- (col (if (plusp columns)
- 0
- (1+ padded-length)))
- (ioutput 0))
- (declare (fixnum string-length padded-length col ioutput)
- (simple-string result))
- (macrolet ((output-char (ch)
- (if (= col columns)
- (progn
- (if stream
- (write-char #\Newline stream)
- (progn
- (setf (schar result ioutput) #\Newline)
- (incf ioutput)))
- (setq col 1))
- (incf col))
- ,@(case output-type
- (:stream
- '((write-char ch stream))
- (:string
- '((setf (schar result ioutput) ch)
- (incf ioutput)))))))
- (labels ((output-group (svalue chars)
- (declare (fixnum svalue chars))
- (output-char
- (schar encode-table
- (the fixnum
- (logand #x3f
- (the fixnum (ash svalue -18))))))
- (output-char
- (schar encode-table
- (the fixnum
- (logand #x3f
- (the fixnum (ash svalue -12))))))
- (if (> chars 2)
- (output-char
- (schar encode-table
- (the fixnum
- (logand #x3f
- (the fixnum (ash svalue -6))))))
- (output-char pad))
- (if (> chars 3)
- (output-char
- (schar encode-table
- (the fixnum
- (logand #x3f svalue))))
- (output-char pad))))
- (do ((igroup 0 (1+ igroup))
- (isource 0 (+ isource 3)))
- ((= igroup complete-group-count)
- (cond
- ((= remainder 2)
- (output-group
- (the fixnum
- (+
- (the fixnum
- (ash
- ,(case input-type
- (:string
- '(char-code (the character (char input isource))))
- (:usb8-array
- '(the fixnum (aref input isource))))
- 16))
- (the fixnum
- (ash
- ,(case input-type
- (:string
- '(char-code (the character (char input (1+ isource)))))
- (:usb8-array
- '(the fixnum (aref input (1+ isource)))))
- 8))))
- 3))
- ((= remainder 1)
- (output-group
- (the fixnum
- ,(case input-type
- (:string
- '(char-code (the character (char input isource))))
- (:usb8-array
- '(the fixnum (aref input isource)))))
- 2)))
- result)
- (declare (fixnum igroup isource))
- (output-group
- (the fixnum
- (+
- (the fixnum
- (ash
- ,(case input-type
- (:string
- '(char-code (the character (char input isource))))
- (:usb8-array
- '(the fixnum (aref input isource))))
- 16))
- (the fixnum
- (ash
- ,(case input-type
- (:string
- '(char-code (the character (char input (1+ isource)))))
- (:usb8-array
- '(the fixnum (aref input (1+ isource)))))
- 8))
- (the fixnum
- ,(case input-type
- (:string
- '(char-code (the character (char input (+ 2 isource)))))
- (:usb8-array
- '(the fixnum (aref input (+ 2 isource)))))
- )))
- 4))))))))
+ (complete-group-count (truncate string-length 3))
+ (remainder (nth-value 1 (truncate string-length 3)))
+ (padded-length (* 4 (truncate (+ string-length 2) 3)))
+ ,@(when (eq output-type :string)
+ '((num-lines (if (plusp columns)
+ (truncate (+ padded-length (1- columns)) columns)
+ 0))
+ (num-breaks (if (plusp num-lines)
+ (1- num-lines)
+ 0))
+ (strlen (+ padded-length num-breaks))
+ (result (make-string strlen))
+ (ioutput 0)))
+ (col (if (plusp columns)
+ 0
+ (the fixnum (1+ padded-length)))))
+ (declare (fixnum string-length padded-length col
+ ,@(when (eq output-type :string)
+ '(ioutput)))
+ ,@(when (eq output-type :string)
+ '((simple-string result))))
+ (labels ((output-char (ch)
+ (if (= col columns)
+ (progn
+ ,@(case output-type
+ (:stream
+ '((write-char #\Newline output)))
+ (:string
+ '((setf (schar result ioutput) #\Newline)
+ (incf ioutput))))
+ (setq col 1))
+ (incf col))
+ ,@(case output-type
+ (:stream
+ '((write-char ch output)))
+ (:string
+ '((setf (schar result ioutput) ch)
+ (incf ioutput)))))
+ (output-group (svalue chars)
+ (declare (fixnum svalue chars))
+ (output-char
+ (schar encode-table
+ (the fixnum
+ (logand #x3f
+ (the fixnum (ash svalue -18))))))
+ (output-char
+ (schar encode-table
+ (the fixnum
+ (logand #x3f
+ (the fixnum (ash svalue -12))))))
+ (if (> chars 2)
+ (output-char
+ (schar encode-table
+ (the fixnum
+ (logand #x3f
+ (the fixnum (ash svalue -6))))))
+ (output-char pad))
+ (if (> chars 3)
+ (output-char
+ (schar encode-table
+ (the fixnum
+ (logand #x3f svalue))))
+ (output-char pad))))
+ (do ((igroup 0 (the fixnum (1+ igroup)))
+ (isource 0 (the fixnum (+ isource 3))))
+ ((= igroup complete-group-count)
+ (cond
+ ((= remainder 2)
+ (output-group
+ (the fixnum
+ (+
+ (the fixnum
+ (ash
+ ,(case input-type
+ (:string
+ '(char-code (the character (char input isource))))
+ (:usb8-array
+ '(the fixnum (aref input isource))))
+ 16))
+ (the fixnum
+ (ash
+ ,(case input-type
+ (:string
+ '(char-code (the character (char input
+ (the fixnum (1+ isource))))))
+ (:usb8-array
+ '(the fixnum (aref input (the fixnum
+ (1+ isource))))))
+ 8))))
+ 3))
+ ((= remainder 1)
+ (output-group
+ (the fixnum
+ (ash
+ ,(case input-type
+ (:string
+ '(char-code (the character (char input isource))))
+ (:usb8-array
+ '(the fixnum (aref input isource))))
+ 16))
+ 2)))
+ ,(case output-type
+ (:string
+ 'result)
+ (:stream
+ 'output)))
+ (declare (fixnum igroup isource))
+ (output-group
+ (the fixnum
+ (+
+ (the fixnum
+ (ash
+ (the fixnum
+ ,(case input-type
+ (:string
+ '(char-code (the character (char input isource))))
+ (:usb8-array
+ '(aref input isource))))
+ 16))
+ (the fixnum
+ (ash
+ (the fixnum
+ ,(case input-type
+ (:string
+ '(char-code (the character (char input
+ (the fixnum (1+ isource))))))
+ (:usb8-array
+ '(aref input (1+ isource)))))
+ 8))
+ (the fixnum
+ ,(case input-type
+ (:string
+ '(char-code (the character (char input
+ (the fixnum (+ 2 isource))))))
+ (:usb8-array
+ '(aref input (+ 2 isource))))
+ )))
+ 4)))))))