Re: [MIT-Scheme-devel] SUBSTRING and SET-STRING-MAXIMUM-LENGTH!

[Chris Hanson]

LGTM.  Can I suggest you order the procedures as per the attached?

On Sun, Sep 6, 2009 at 10:06 AM, Joe Marshall<address@hidden> wrote:
> Hello cph,
>
> I'd like you do a code review....
>
> (declare (integrate-operator %string-head))
> (define (%string-head string end)
>  (%substring string 0 end))
>
> (define (string-head string end)
>  (guarantee-string string 'STRING-HEAD)
>  (guarantee-string-index end 'STRING-HEAD)
>  (%string-head string end))
>
> (define-syntax chars-to-words-shift
>  (sc-macro-transformer
>   (lambda (form environment)
>     form environment
>     ;; This is written as a macro so that the shift will be a constant
>     ;; in the compiled code.
>     ;; It does not work when cross-compiled!
>     (let ((chars-per-word (vector-ref (gc-space-status) 0)))
>       (case chars-per-word
>         ((4) -2)
>         ((8) -3)
>         (else (error "Can't support this word size:" chars-per-word)))))))
>
> (define (%truncate-string! string end)
>  (if (not (and (fix:>= end 0)
>                (fix:< end
>                       (fix:lsh (fix:- (system-vector-length string) 1)
>                                (fix:- 0 (chars-to-words-shift))))))
>      (error:bad-range-argument end 'STRING-HEAD!))
>  (let ((mask (set-interrupt-enables! interrupt-mask/none)))
>    ((ucode-primitive primitive-object-set! 3)
>     string
>     0
>     ((ucode-primitive primitive-object-set-type 2)
>      (ucode-type manifest-nm-vector)
>      (fix:+ 1 (chars->words (fix:+ end 1)))))
>    (set-string-length! string (fix:+ end 1))
>    (string-set! string end #\nul)
>    (set-string-length! string end)
>    (set-interrupt-enables! mask)
>    string))
>
> (define %string-head!
>  (if (compiled-procedure? %truncate-string!)
>      %truncate-string!
>      %string-head))
>
> (define (string-head! string end)
>  (guarantee-string string 'STRING-HEAD!)
>  (guarantee-string-index end 'STRING-HEAD!)
>  (%string-head! string end))
>
>
> --
> ~jrm
>

joe.scm
Description: Binary data