LGTM. Can I suggest you order the procedures as per the attached?
On Sun, Sep 6, 2009 at 10:06 AM, Joe Marshall<[email protected]> 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
_______________________________________________ MIT-Scheme-devel mailing list [email protected] http://lists.gnu.org/mailman/listinfo/mit-scheme-devel
