(defun frob-do-body (varlist endlist decls-and-code bind step name block)
(let* ((r-inits nil) ; accumulator for reversed list
(r-steps nil) ; accumulator for reversed list
(defun frob-do-body (varlist endlist decls-and-code bind step name block)
(let* ((r-inits nil) ; accumulator for reversed list
(r-steps nil) ; accumulator for reversed list
- (go ,label-2)
- ,label-1
- ,@code
- (,step ,@(nreverse r-steps))
- ,label-2
- (unless ,(first endlist) (go ,label-1))
- (return-from ,block (progn ,@(rest endlist))))))))))
+ (go ,label-2)
+ ,label-1
+ (tagbody ,@code)
+ (,step ,@(nreverse r-steps))
+ ,label-2
+ (unless ,(first endlist) (go ,label-1))
+ (return-from ,block (progn ,@(rest endlist))))))))))
;;; This is like DO, except it has no implicit NIL block. Each VAR is
;;; initialized in parallel to the value of the specified INIT form.
;;; This is like DO, except it has no implicit NIL block. Each VAR is
;;; initialized in parallel to the value of the specified INIT form.
;;; Concatenate together the names of some strings and symbols,
;;; producing a symbol in the current package.
;;; Concatenate together the names of some strings and symbols,
;;; producing a symbol in the current package.
;; Well, this is called early in cold-init, before
;; the type system is set up; however, now that we
;; check for bad lengths, the type system is needed
;; for calls to CONCATENATE. So we need to make sure
;; that the calls are transformed away:
;; Well, this is called early in cold-init, before
;; the type system is set up; however, now that we
;; check for bad lengths, the type system is needed
;; for calls to CONCATENATE. So we need to make sure
;; that the calls are transformed away:
- (the simple-string (string (car things)))
- (the simple-string (string (cadr things)))))
+ (the simple-base-string
+ (string (car things)))
+ (the simple-base-string
+ (string (cadr things)))))
- (the simple-string (string (car things)))
- (the simple-string (string (cadr things)))
- (the simple-string (string (caddr things)))))
+ (the simple-base-string
+ (string (car things)))
+ (the simple-base-string
+ (string (cadr things)))
+ (the simple-base-string
+ (string (caddr things)))))