Changeset 27358 in project
- Timestamp:
- 09/01/12 23:01:57 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
release/4/latch/trunk/latch.scm
r18748 r27358 42 42 body ...))))) 43 43 44 ;;XXX 45 #;(define (snap from to) 46 (##sys#check-procedure from 'snap) 47 (##sys#check-procedure to 'snap) 48 (let ((fromsize (##sys#size from)) 49 (tosize (##sys#size to)) 50 (psize (fxmax fromsize tosize))) 51 (define (copy src dest n) 52 (do ((i 0 (fx+ i 1))) 53 ((fx>= i n)) 54 (##sys#setslot dest i (##sys#slot src i)))) 55 (letrec ((proc 56 (lambda args 57 (let ((from from)) ; copy may overwrite closure-slot of free "from" variable! 58 (copy to proc tosize) ; does optimizer interfere? 59 (apply from args))))) 60 (set! psize (fxmax psize (##sys#size proc))) 61 (let ((v (make-vector psize))) 62 (copy proc v (##sys#size proc)) 63 (##core#inline "C_vector_to_closure" v) 64 v)))) 65 44 66 )
Note: See TracChangeset
for help on using the changeset viewer.