[foo-cvs] foo/elkfoo/scm/control/interface-lib sp-components.foo,1.1,1.2 sp-datapack-funs.foo,1.1,1.2 sp-patchgen-funs.foo,1.1,1.2 sp-sigpack-type.foo,1.1,1.2

[Martin R. <ru...@us...>]

Update of /cvsroot/foo/foo/elkfoo/scm/control/interface-lib
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8357/interface-lib

Modified Files:
	sp-components.foo sp-datapack-funs.foo sp-patchgen-funs.foo 
	sp-sigpack-type.foo 
Log Message:
raw checkin of new control

Index: sp-components.foo
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/scm/control/interface-lib/sp-components.foo,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** sp-components.foo	7 Aug 2004 22:53:01 -0000	1.1
--- sp-components.foo	27 Feb 2005 20:06:33 -0000	1.2
***************
*** 1,2 ****
--- 1,10 ----
+ ;
+ ;;
+ ;;; missing modules
+ ;
+ ; cbiquad~ in d0 d1 d2 c0 c1 //foo:shelfing-coefs
+ ; osc~ frq tablefile [initphase] // tablefile length = power of two
+ ; reverb8~ tr0 trl trm trh fl fh
+ 
  (define (Bln Dur Frq . args)
     (let* ((Frq  (Sigpar-fun Frq Dur))
***************
*** 9,12 ****
--- 17,28 ----
  	(bln~ Frq taps seed)))
  
+ (define (CBiquad Dur Glow Gmed Ghih Flow Fmed Input)
+    (let ((Input (Input-fun Input Dur))
+ 	 (SR (foo-default-srate)))
+ 	(apply cbiquad~ (append 
+ 			 (list Input)
+ 			 (foo:shelfing-coefs Glow Gmed Ghih Flow Fmed SR)))
+ 	))
+ 
  (define (Cfilter Dur Frq Bdw Input)
     (let ((Input (Input-fun Input Dur)))
***************
*** 65,68 ****
--- 81,90 ----
  		  (noise~))))
  
+ (define (Osc Dur Frq TablFile . initphas)
+    (let ((Frq      (Sigpar-fun Frq Dur))
+          (initphas (cleanlist initphas)))
+ 	(if (not (null? initphas))  (osc~ Frq TablFile(car initphas))
+ 		     		    (osc~ Frq TablFile))))
+ 
  (define (Reverb Dur NCh Ndl Rvt0 Damp Input . delays)
    (let ((Input (if (pair? Input) (map (lambda (x) (Input-fun x Dur)) Input)
***************
*** 99,103 ****
--- 121,188 ----
        (do ((c NCh (- c 1))) ((= c 0) (if (= (length rout) 1) (car rout) rout))
  	   (set! rout (cons (revout~ c rin) rout)))))
+ ;
+ ;;
+ ;;; True definition of Reverb8Nw but revout~ doesn't work yet with revreb8~
+ ;;; so we use the next definition for the time being. Mono output.
+ ;;
+ ;
+ (define (ReverbNw Dur NCh Rvt0 RvtL RvtM RvtH FrqL FrqH Input . delays)
+   (let ((Input (if (pair? Input) (map (lambda (x) (Input-fun x Dur)) Input)
+ 				 (list (Input-fun Input Dur))))
+     	(delays (if (not (null? delays)) (list (flatten delays)) '()))
+ 	(Cmbjn (if (= (modulo NCh 2) 0) NCh (+ NCh 1)))
+ 	(rin) (rout))
+     (set! rin 
+ 	   (apply reverb8~ (append (list Rvt0 RvtL RvtM RvtH FrqL FrqH Cmbjn)
+ 				   Input delays)))
+     (do ((c NCh (- c 1))) ((= c 0) (if (= (length rout) 1) (car rout) rout))
+        (set! rout (cons (revout~ c rin) rout)))))
  
+ ;(define (ReverbNw Dur NCh Rvt0 RvtL RvtM RvtH FrqL FrqH Input . delays)
+ ;  (let* ((Input (if (pair? Input) (map (lambda (x) (Input-fun x Dur)) Input)
+ ;		                  (list (Input-fun Input Dur))))
+ ;;	 (Cmbjn (if (= (modulo NCh 2) 0) NCh (+ NCh 1)))
+ ;	 (Cmbjn 2)
+ ;	 (rin) (rout)
+ ;	 (del1 (if (not (null? delays)) (list (flatten delays)) '()))
+ ;;	       '(.051129990 .059387966 .062981972 .069091782
+ ;;	         .078113106 .083835861 .090198380 .098070000))) ;default
+ ;	 (del2 '((.051129997 .059387965 .062981977 .069091789
+ ;		 .078113104 .083835861 .090198385 .098070008)))
+ ;	 (del3 '((.051129993 .059387962 .062981977 .069091784
+ ;		 .078113105 .083835861 .090198388 .098070007)))
+ ;	 (del4 '((.051129993 .059387963 .062981975 .069091783
+ ;	         .078113103 .083835864 .090198385 .098070003)))
+ ;	 (del5 '((.051129999 .059387961 .062981977 .069091789
+ ;		 .078113100 .083835867 .090198381 .098070007)))
+ ;	 (del6 '((.051129994 .059387968 .062981977 .069091788
+ ;	         .078113109 .083835862 .090198387 .098070003)))
+ ;	 (del7 '((.051129994 .059387965 .062981977 .069091781
+ ;		 .078113106 .083835866 .090198388 .098070008)))
+ ;	 (del8 '((.051129990 .059387964 .062981978 .069091780
+ ;		 .078113102 .083835869 .090198388 .098070006)))
+ ;	(delaylst (list del1 del2 del3 del4 del5 del6 del7 del8)))
+ ;;    (prn Dur NCh Rvt0 RvtL RvtM RvtH FrqL FrqH)
+ ;    (if (= NCh 1)
+ ;       (apply reverb8~ 
+ ;	      (append (list Rvt0 RvtL RvtM RvtH FrqL FrqH Cmbjn) Input del1))
+ ;       (if (= (length Input) NCh)
+ ;	(begin
+ ;	  (prn "NChns Out = NChans In")
+ ;	  (map 
+ ;	   (lambda (inp) 
+ ;	     (apply reverb8~ (append (list Rvt0 RvtL RvtM RvtH FrqL FrqH Cmbjn)
+ ;				     (list inp) del1))) Input))
+ ;	  (map 
+ ;	   (lambda (dels) 
+ ;	     (apply reverb8~ (append (list Rvt0 RvtL RvtM RvtH FrqL FrqH Cmbjn)
+ ;				     Input dels))) delaylst)))
+ ;    ))
+ ;;
+ ;
+ ;;
+ ;;;
+ ;;
+ ;
  (define (Sampler Dur Frq Snd . taps)
    (let ((Snd  (Sndpar-fun Snd))
***************
*** 105,110 ****
  	(taps (if (not (null? (cleanlist taps))) (cleanlist taps) #f)))
       (if (pair? Snd)
! 	(apply add~ (map (lambda (x) (if taps (transp-snd~ Snd Frq (car taps))
! 	  	 			      (transp-snd~ Snd Frq))) Snd))
  	(if taps (transp-snd~ Snd Frq (car taps))
  		 (transp-snd~ Snd Frq)))))
--- 190,195 ----
  	(taps (if (not (null? (cleanlist taps))) (cleanlist taps) #f)))
       (if (pair? Snd)
! 	(apply add~ (map (lambda (x) (if taps (transp-snd~ x Frq (car taps))
! 	  	 			      (transp-snd~ x Frq))) Snd))
  	(if taps (transp-snd~ Snd Frq (car taps))
  		 (transp-snd~ Snd Frq)))))
***************
*** 124,128 ****
     (let ((Input (Input-fun Input Dur))
  	 (Frq   (Sigpar-fun Frq Dur))
! 	 (Bdw   (Sigpar-fun Bdw Dur)))
  	(v2pf~ Input Frq Bdw)))
  
--- 209,213 ----
     (let ((Input (Input-fun Input Dur))
  	 (Frq   (Sigpar-fun Frq Dur))
! 	 (Bdw   (Sigpar-fun Bdw Dur))); (prn Bdw) (print~ Bdw)
  	(v2pf~ Input Frq Bdw)))
  

Index: sp-patchgen-funs.foo
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/scm/control/interface-lib/sp-patchgen-funs.foo,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** sp-patchgen-funs.foo	7 Aug 2004 22:53:01 -0000	1.1
--- sp-patchgen-funs.foo	27 Feb 2005 20:06:33 -0000	1.2
***************
*** 10,14 ****
      	(Input  (if (null? (flatout Input)) '() (flatout Input))))
  
!     (if (and (not (null? Args)) (= (length Args) 1)) (set! Args (car Args)))		
      (time Off
  	(if (not (null? Input))
--- 10,14 ----
      	(Input  (if (null? (flatout Input)) '() (flatout Input))))
  
!     (if (and (not (null? Args)) (= (length Args) 1)) (set! Args (car Args)))
      (time Off
  	(if (not (null? Input))
***************
*** 110,123 ****
  	(#t	(error 'SP-run "Unknown Mode ~s" Mode))))
  
  (define (ParseType Type)
     (if (symbol? Type) (set! Type (symbol->string Type)))
     (cond
! 	((string-ci=? Type "Incremental")	'incremental)
! 	((string-ci=? Type "Float")		'float)
! 	((string-ci=? Type "Short")		'short)
! 	((string-ci=? Type "Long")		'long)
! 	((string-ci=? Type "Double")		'double)
! 	((string-ci=? Type "Char")		'char)
! 	(#t	(error 'SP-run "Unknown Snd-Type ~s" Type))))
  
  (define (putimx filnam)
--- 110,155 ----
  	(#t	(error 'SP-run "Unknown Mode ~s" Mode))))
  
+ (define (ParseTypeFormat Type Format)
+   (let ((aux))
+    (if (not Type) (set! Type foo-default-soundfile-filetype)
+ 		  (set! aux (ParseFormat Type))
+ 		  (if aux (begin (set! Format aux)
+ 		          	 (set! Type foo-default-soundfile-filetype))
+ 			  (set! Type (ParseType Type))))
+    (if (not Format) 
+       (set! Format 'float)
+       (set! Format (ParseFormat Format))
+       (if (not Format) (error 'SP-run "Unknown Snd-Format ~s" Format)))
+    (list Type Format)))
+ 
+ (define (ParseFormat Format)
+    (if (symbol? Format) (set! Format (symbol->string Format)))
+    (cond
+ ;	((string-ci=? Format "Incremental")	'incremental)
+ 	((string-ci=? Format "Float")		'float)
+ 	((string-ci=? Format "Short")		'short)
+ 	((string-ci=? Format "Long")		'long)
+ 	((string-ci=? Format "Double")		'double)
+ 	((string-ci=? Format "Char")		'char)
+ 	(#t                                     #f)))
+ 
  (define (ParseType Type)
     (if (symbol? Type) (set! Type (symbol->string Type)))
     (cond
!         ((string-ci=? Type "Incremental")'incremental)
! 	((string-ci=? Type "Wav")	'wav)
! 	((string-ci=? Type "Aiff")	'aiff)
! 	((string-ci=? Type "Snd")	'snd)
! 	((string-ci=? Type "Paf")	'paf)
! 	((string-ci=? Type "Svx")	'svx)
! 	((string-ci=? Type "Nist")	'nist)
! 	((string-ci=? Type "Vac")	'vac)
! 	((string-ci=? Type "Ircam")	'ircam)
! 	((string-ci=? Type "Wav64")	'wav64)
! 	((string-ci=? Type "Mat4")	'mat4)
! 	((string-ci=? Type "Mat5")	'mat5)
! 	((string-ci=? Type "Pvf")	'pvf)
! 	((string-ci=? Type "Xi")	'xi)
! 	(#t	(error 'SP-run "Unknown Soundfile Type ~s" Type))))
  
  (define (putimx filnam)
***************
*** 189,193 ****
  	(Workfile) (FileRS)
     	(Mode 'punch) (Off 0) (Ref 0) (Sclr 1) (Nfctr 1)
! 	(Chns) (Type 'float) (SRat) (SRc)  
  	(Offctxt) (Durctxt) (Chnctxt) (Pflg #t)
  	(aux) (ctxt) (DUM) (strm) (tsk) (flg #t)
--- 221,227 ----
  	(Workfile) (FileRS)
     	(Mode 'punch) (Off 0) (Ref 0) (Sclr 1) (Nfctr 1)
! 	(Chns) (SRat) (SRc)
! ;	(Format 'float) (Type 'aiff) 	
! 	(Format #f) (Type #f) 
  	(Offctxt) (Durctxt) (Chnctxt) (Pflg #t)
  	(aux) (ctxt) (DUM) (strm) (tsk) (flg #t)
***************
*** 209,218 ****
      (set! DUM (assq 'Snd-Chns Args))	(if DUM (set! Chns (cadr DUM)))
      (set! DUM (assq 'Snd-Type Args))	(if DUM (set! Type (cadr DUM)))
      (set! DUM (assq 'Snd-SR Args))	(if DUM (set! SRat (cadr DUM)))
      (set! DUM (assq 'Task-SR Args))	(if DUM (set! SRc (cadr DUM)))
      (set! DUM (assq 'Print Args))	(if DUM (set! Pflg (cadr DUM)))
      (if (symbol? Filename) (set! Filename (symbol->string Filename)))
!     (set! Mode (ParseMode Mode))
!     (set! Type (ParseType Type))
      (cond
        ((equal? Mode 'Undo)
--- 243,260 ----
      (set! DUM (assq 'Snd-Chns Args))	(if DUM (set! Chns (cadr DUM)))
      (set! DUM (assq 'Snd-Type Args))	(if DUM (set! Type (cadr DUM)))
+     (set! DUM (assq 'Snd-Format Args))	(if DUM (set! Format (cadr DUM)))
      (set! DUM (assq 'Snd-SR Args))	(if DUM (set! SRat (cadr DUM)))
      (set! DUM (assq 'Task-SR Args))	(if DUM (set! SRc (cadr DUM)))
      (set! DUM (assq 'Print Args))	(if DUM (set! Pflg (cadr DUM)))
      (if (symbol? Filename) (set! Filename (symbol->string Filename)))
!     (set! Mode   (ParseMode   Mode))
! ;
! ;;  for backward compatibility {the old Type was the new Format}
! ;;  we group in one function the parsing of Type and Format
! ;
!     (set! DUM   (ParseTypeFormat Type Format))
!     (set! Type (car DUM))
!     (set! Format (cadr DUM))
! ;
      (cond
        ((equal? Mode 'Undo)
***************
*** 271,287 ****
  
  	    (set! Workfile
  	      (make-sndname
  	    	(if (equal? Type 'incremental)
! 		   (begin (set! Mode 'blend) (string-append Filename ".imx"))
! 		   Filename)))
  	    (if (file-exists? Workfile)
  	       (if (not (equal? Mode 'blend))
! 	          (if (or (equal? Filename foo:name)
  	       	          (SP-Demand Workfile))
  		     (begin
  		        (system (string-append "rm -rf "Workfile))
!                         (make-soundfile Workfile Type Chns SRat))
                       (set! flg #f)))
! 		(make-soundfile Workfile Type Chns SRat))
  
  	    (if flg
--- 313,333 ----
  
  	    (set! Workfile
+ 	     (tilde-expand
  	      (make-sndname
  	    	(if (equal? Type 'incremental)
! 		   (begin (set! Mode 'blend)
! 			  (set! Format 'auto)
! 			  (string-append Filename ".imx"))
! 		   (if (equal? Filename foo:name) (foo:test-file-name)
! 		                                  Filename)))))
  	    (if (file-exists? Workfile)
  	       (if (not (equal? Mode 'blend))
! 	          (if (or (equal? Workfile (foo:test-file-name))
  	       	          (SP-Demand Workfile))
  		     (begin
  		        (system (string-append "rm -rf "Workfile))
!                         (make-soundfile Workfile Type Format SRat Chns))
                       (set! flg #f)))
! 		(make-soundfile Workfile Type Format SRat Chns))
  
  	    (if flg
***************
*** 294,298 ****
  	           (prn " Synthesizing = <<Duration Factor>> ==> "Dur Sclr))
  	        (run-task tsk Dur Sclr)
! 	        (if (and (equal? Type 'float)
  	       		 (not (equal? Mode 'blend)))
  	          (begin
--- 340,344 ----
  	           (prn " Synthesizing = <<Duration Factor>> ==> "Dur Sclr))
  	        (run-task tsk Dur Sclr)
! 	        (if (and (equal? Format 'float)
  	       		 (not (equal? Mode 'blend)))
  	          (begin
***************
*** 400,403 ****
--- 446,463 ----
  	 (equal? Type 'Bln)
  	 (equal? Type Bln))	(append (list SP-Component Bln Dur) Args))
+ 
+     ((or (equal? Type 'ReverbNw)
+ 	 (equal? Type 'Reverbnw)
+ 	 (equal? Type 'reverbnw)
+       (equal? Type ReverbNw))  (append (list SP-Component ReverbNw Dur) Args))
+     ((or (equal? Type 'CBiquad)
+ 	 (equal? Type 'cbiquad)
+ 	 (equal? Type 'shelf)
+ 	 (equal? Type CBiquad))	(append (list SP-Component CBiquad Dur) Args))
+     ((or (equal? Type 'Osc)
+ 	 (equal? Type 'osc)
+ 	 (equal? Type 'Oscillator)
+ 	 (equal? Type Osc))	(append (list SP-Component Osc Dur) Args))
+ 
      ((or (equal? Type 'Module)
  	 (equal? Type Module))	(append (list SP-Component Module Dur) Args))
***************
*** 486,489 ****
--- 546,563 ----
  	     (equal? Type 'Bln)
  	     (equal? Type Bln))		(append (list Bln) Args))
+ 
+ 	((or (equal? Type 'ReverbNw)
+ 	     (equal? Type 'Reverbnw)
+ 	     (equal? Type 'reverbnw)
+ 	     (equal? Type ReverbNw))  (append (list ReverbNw) Args (list Inp)))
+ 	((or (equal? Type 'CBiquad)
+ 	     (equal? Type 'cbiquad)
+ 	     (equal? Type 'shelf)
+ 	     (equal? Type CBiquad))   (append (list CBiquad) Args (list Inp)))
+ 	((or (equal? Type 'Osc)
+ 	     (equal? Type 'osc)
+ 	     (equal? Type 'Oscillator)
+ 	     (equal? Type Osc))	      (append (list Osc) Args))
+ 	
  	((or (equal? Type 'Module)
  	     (equal? Type Module)) (if (not (null? Inp))

Index: sp-datapack-funs.foo
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/scm/control/interface-lib/sp-datapack-funs.foo,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** sp-datapack-funs.foo	7 Aug 2004 22:53:01 -0000	1.1
--- sp-datapack-funs.foo	27 Feb 2005 20:06:33 -0000	1.2
***************
*** 9,13 ****
  ;
  
! (define (Sigpar-fun Pack Dur)
    (let ((Dur (if (number? Dur) Dur 1)))
  
--- 9,13 ----
  ;
  
! (define (Sigpar-fun Pack Dur) ;(prn "Sigpar-fun "Pack Dur)
    (let ((Dur (if (number? Dur) Dur 1)))
  
***************
*** 188,198 ****
  	(#t			(let ((Amp (Sigpar-fun (car Pack) Dur))
  			      	      (Frq (Sigpar-fun (cadr Pack) Dur)))
! 				   (mul~ Amp  (bln~ Frq 4 1993))))))
  
  (define (Jittermod Pack Dur)
     (let ((Amp (Sigpar-fun (car Pack) Dur)))
!        (mul~ Amp (~ 2.13) (div~ (add~ (bln~ (~ 20.134) 4 1993)
!        				      (bln~ (~ 9.109) 4 1994)
!        				      (bln~ (~ 0.821) 4 1995)) (~ 3)))))
  
  (define (Decode-spk arg Dur)
--- 188,198 ----
  	(#t			(let ((Amp (Sigpar-fun (car Pack) Dur))
  			      	      (Frq (Sigpar-fun (cadr Pack) Dur)))
! 				   (mul~ Amp  (bln~ Frq 6 1993))))))
  
  (define (Jittermod Pack Dur)
     (let ((Amp (Sigpar-fun (car Pack) Dur)))
!        (mul~ Amp (~ 2.13) (div~ (add~ (bln~ (~ 20.134) 6 1993)
!        				      (bln~ (~ 9.109)  6 1994)
!        				      (bln~ (~ 0.821)  6 1995)) (~ 3)))))
  
  (define (Decode-spk arg Dur)
***************
*** 256,260 ****
     	((snd? Pack)	    	Pack)
  	((or (string? Pack)
! 	     (symbol? Pack)) 	(open-snd Pack))
  	((procedure? Pack)	(Pack))
  	((node? Pack)		(compute-node Pack))
--- 256,260 ----
     	((snd? Pack)	    	Pack)
  	((or (string? Pack)
! 	     (symbol? Pack)) 	(Eval-sndpack (make-sndpack Pack)))
  	((procedure? Pack)	(Pack))
  	((node? Pack)		(compute-node Pack))
***************
*** 264,281 ****
  
  (define (get-Sound Pack)
!   (let ((Snd  (sndpack.name Pack))
!   	(Chnl (sndpack.channel Pack)))
  
      (set! Snd
  	    (cond
! 	        ((procedure? Snd)		(Snd))
! 		((or (string? Snd)
! 		     (symbol? Snd))		(open-snd Snd))
! 		((snd? Snd)			Snd)))
      (set! Chnl
  	    (cond
  		((number? Chnl)			Chnl)
  		((and (pair? Chnl)
! 		      (numerical? Chnl))	Chnl)))
  
      (cond
--- 264,287 ----
  
  (define (get-Sound Pack)
!   (let ((Snd  (make-sndname (sndpack.name Pack)))
!   	(Chnl (sndpack.channel Pack))
! 	(Nchs 1))
  
      (set! Snd
  	    (cond
! 	        ((procedure? Snd)	(Snd))
! 		((symbol? Snd)		(set! Snd (symbol->string Snd))
! 					(set! Nchs (soundfile-channels Snd))
! 					(open-snd Snd))
! 		((string? Snd)		(set! Nchs (soundfile-channels Snd))
! 					(open-snd Snd))
! 		((snd? Snd)		Snd)))
      (set! Chnl
  	    (cond
  		((number? Chnl)			Chnl)
  		((and (pair? Chnl)
! 		      (numerical? Chnl))	Chnl)
!                 ((and (null? Chnl)
!                       (> Nchs 1))         (mk-ordrlst Nchs 1))))
  
      (cond
***************
*** 382,391 ****
  
        ((snd? Pack)	(read-snd~ Pack))
!       ((sndpack? Pack)	(set! Snd (Sndpar-fun Pack))
!       			(if (pair? Snd)
! 			    (apply add~ (map (lambda (x) (read-snd~ x)) Snd))
! 			    (read-snd~ Snd)))
!       ((string? Pack)   (read-snd~ (Sndpar-fun Pack)))
!       ((symbol? Pack)	(read-snd~ (Sndpar-fun Pack)))
        ((and (pair? Pack)
        	    (or (snd? (car Pack))
--- 388,398 ----
  
        ((snd? Pack)	(read-snd~ Pack))
!       ((or (string? Pack)
! 	   (sndpack? Pack)
! 	   (symbol? Pack))  (set! Snd (Sndpar-fun Pack))
! 	                    (if (pair? Snd)
! 			       (apply add~ 
! 				      (map (lambda (x) (read-snd~ x)) Snd))
! 			       (read-snd~ Snd)))
        ((and (pair? Pack)
        	    (or (snd? (car Pack))

Index: sp-sigpack-type.foo
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/scm/control/interface-lib/sp-sigpack-type.foo,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** sp-sigpack-type.foo	7 Aug 2004 22:53:01 -0000	1.1
--- sp-sigpack-type.foo	27 Feb 2005 20:06:33 -0000	1.2
***************
*** 312,322 ****
   (set! set-sigpack.rfr
      (lambda (obj val)
!      (make-sigpack val (sigpack.env obj) (sigpack.mod obj) (sigpack.val obj))))
   (set! set-sigpack.env
      (lambda (obj val)
!      (make-sigpack (sigpack.rfr obj) val (sigpack.mod obj) (sigpack.val obj))))
   (set! set-sigpack.mod
      (lambda (obj val)
!      (make-sigpack (sigpack.rfr obj) (sigpack.env obj) val (sigpack.val obj))))
   (set! set-sigpack.cal
      (lambda (obj val)
--- 312,322 ----
   (set! set-sigpack.rfr
      (lambda (obj val)
!      (make-sigpack val (sigpack.env obj) (sigpack.mod obj) (sigpack.cal obj))))
   (set! set-sigpack.env
      (lambda (obj val)
!      (make-sigpack (sigpack.rfr obj) val (sigpack.mod obj) (sigpack.cal obj))))
   (set! set-sigpack.mod
      (lambda (obj val)
!      (make-sigpack (sigpack.rfr obj) (sigpack.env obj) val (sigpack.cal obj))))
   (set! set-sigpack.cal
      (lambda (obj val)