(FILECREATED "30-Jul-84 12:38:20" {ERIS}<SPEECH>COEWAVE.FPKG;5
 24249  

      changes to:  (FNS SPEECH.COEFF.TO.WAVE)

      previous date: " 2-Jul-84 19:17:23" {ERIS}<SPEECH>COEWAVE.FPKG;4)


(* Copyright (c) 1984 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT COEWAVECOMS)

(RPAQQ COEWAVECOMS
 ((INITVARS (SPEECH.*SIGNAL* 'ULIPS))
		    (RECORDS REG MEMORY)
		    (FNS SPEECH.CREATE.MEMORY SPEECH.INIT.MEMORY SPEECH.INIT.REG SPEECH.COEFF.TO.WAVE 
			 SPEECH.CTW SPEECH.TRACE SPEECH.CTW.SCOPE SPEECH.CTW.TURBULENCE 
			 SPEECH.CTW.CASCADE SPEECH.CTW.PARALLEL SPEECH.CTW.SUM SPEECH.UPDATE.RES 
			 SPEECH.UPDATE.ANTIRES SPEECH.CTW.GAUSSIAN)))

(RPAQ? SPEECH.*SIGNAL*
 'ULIPS)
[DECLARE: EVAL@COMPILE 

(RECORD REG
 (T1 T2))

(DATATYPE MEMORY
 (REG1P REG2P REG3P REG4P REG5P REG6P REGNP REGN REG1C REG2C REG3C REG4C REG5C REG6C 
			REGNPC REGNZC REGGP REGGS1 REGGS2 REGGZ NPULSE MPULSE UGLOT UGLOT1 USUMC UDIF 
			USUMP PLSTEP AFRIC DFRIC UFRIC AASPIR DASPIR UASPIR UCASC UPAR ULIPS OUTPUT))
]
(/DECLAREDATATYPE 'MEMORY
		  '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
			    POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
			    POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
			    POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
			    POINTER))
(DEFINEQ

(SPEECH.CREATE.MEMORY

  [LAMBDA NIL                                                (* pkh: "29-May-84 12:54")

    (PROG (MEMORY)
          (SETQ MEMORY (create
 MEMORY
			       REG1P ← (create
 REG)
			       REG2P ← (create
 REG)
			       REG3P ← (create
 REG)
			       REG4P ← (create
 REG)
			       REG5P ← (create
 REG)
			       REG6P ← (create
 REG)
			       REGN ← (create
 REG)
			       REGNP ← (create
 REG)
			       REG1C ← (create
 REG)
			       REG2C ← (create
 REG)
			       REG3C ← (create
 REG)
			       REG4C ← (create
 REG)
			       REG5C ← (create
 REG)
			       REG6C ← (create
 REG)
			       REGNPC ← (create
 REG)
			       REGNZC ← (create
 REG)
			       REGGP ← (create
 REG)
			       REGGS1 ← (create
 REG)
			       REGGS2 ← (create
 REG)
			       REGGZ ← (create
 REG)))
          (RETURN MEMORY])

(SPEECH.INIT.MEMORY

  [LAMBDA (MEMORY)                                           (* pkh: "29-May-84 12:54")

    (PROG NIL
          (SPEECH.INIT.REG
 (fetch
 (MEMORY REG1P) of
 MEMORY))
          (SPEECH.INIT.REG
 (fetch
 (MEMORY REG2P) of
 MEMORY))
          (SPEECH.INIT.REG
 (fetch
 (MEMORY REG3P) of
 MEMORY))
          (SPEECH.INIT.REG
 (fetch
 (MEMORY REG4P) of
 MEMORY))
          (SPEECH.INIT.REG
 (fetch
 (MEMORY REG5P) of
 MEMORY))
          (SPEECH.INIT.REG
 (fetch
 (MEMORY REG6P) of
 MEMORY))
          (SPEECH.INIT.REG
 (fetch
 (MEMORY REGN) of
 MEMORY))
          (SPEECH.INIT.REG
 (fetch
 (MEMORY REGNP) of
 MEMORY))
          (SPEECH.INIT.REG
 (fetch
 (MEMORY REG1C) of
 MEMORY))
          (SPEECH.INIT.REG
 (fetch
 (MEMORY REG2C) of
 MEMORY))
          (SPEECH.INIT.REG
 (fetch
 (MEMORY REG3C) of
 MEMORY))
          (SPEECH.INIT.REG
 (fetch
 (MEMORY REG4C) of
 MEMORY))
          (SPEECH.INIT.REG
 (fetch
 (MEMORY REG5C) of
 MEMORY))
          (SPEECH.INIT.REG
 (fetch
 (MEMORY REG6C) of
 MEMORY))
          (SPEECH.INIT.REG
 (fetch
 (MEMORY REGNPC) of
 MEMORY))
          (SPEECH.INIT.REG
 (fetch
 (MEMORY REGNZC) of
 MEMORY))
          (SPEECH.INIT.REG
 (fetch
 (MEMORY REGGP) of
 MEMORY))
          (SPEECH.INIT.REG
 (fetch
 (MEMORY REGGS1) of
 MEMORY))
          (SPEECH.INIT.REG
 (fetch
 (MEMORY REGGS2) of
 MEMORY))
          (SPEECH.INIT.REG
 (fetch
 (MEMORY REGGZ) of
 MEMORY))
          (replace
 (MEMORY NPULSE) of
 MEMORY with
 1)
          (replace
 (MEMORY MPULSE) of
 MEMORY with
 0)
          (replace
 (MEMORY PLSTEP) of
 MEMORY with
 0.0)
          (replace
 (MEMORY AFRIC) of
 MEMORY with
 0.0)
          (replace
 (MEMORY AASPIR) of
 MEMORY with
 0.0)
          (replace
 (MEMORY DFRIC) of
 MEMORY with
 0.0)
          (replace
 (MEMORY UFRIC) of
 MEMORY with
 0.0)
          (replace
 (MEMORY DASPIR) of
 MEMORY with
 0.0)
          (replace
 (MEMORY UASPIR) of
 MEMORY with
 0.0)
          (replace
 (MEMORY UGLOT) of
 MEMORY with
 0.0)
          (replace
 (MEMORY USUMC) of
 MEMORY with
 0.0)
          (replace
 (MEMORY UDIF) of
 MEMORY with
 0.0)
          (replace
 (MEMORY USUMP) of
 MEMORY with
 0.0)
          (replace
 (MEMORY UCASC) of
 MEMORY with
 0.0)
          (replace
 (MEMORY UPAR) of
 MEMORY with
 0.0)
          (replace
 (MEMORY OUTPUT) of
 MEMORY with
 0.0])

(SPEECH.INIT.REG

  [LAMBDA (REG)                                              (* pkh: "29-May-84 12:54")

    (PROG NIL
          (replace
 (REG T1) of
 REG with
 0.0)
          (replace
 (REG T2) of
 REG with
 0.0])

(SPEECH.COEFF.TO.WAVE

  [LAMBDA (MEMORY COEFF WAVE OFFSET PERIOD)                  (* pkh: "27-Jul-84 18:36")

    (PROG (OUTPUT)                                           (* Delta amplitudes of aspiration and frication.

							     *)

          [replace
 (MEMORY DASPIR) of
 MEMORY with
 (FTIMES NSAMI (FDIFFERENCE (fetch
 (COEFF AASPIR)
										of
 COEFF)
									     (fetch
 (MEMORY AASPIR)
										of
 MEMORY]
          [replace
 (MEMORY DFRIC) of
 MEMORY with
 (FTIMES NSAMI (FDIFFERENCE (fetch
 (COEFF AFRIC)
									       of
 COEFF)
									    (fetch
 (MEMORY AFRIC)
									       of
 MEMORY]
                                                             (* Plosive release. *)

          (replace
 (MEMORY PLSTEP) of
 MEMORY with
 (FMINUS (fetch
 (COEFF PLSTEP) of
 COEFF)))
                                                             (* Main loop *)

          (for
 (NTIME ← 1) to
 PERIOD while
 (ILEQ (IPLUS OFFSET NTIME)
						 USER.TMAX)
	     do
 (SPEECH.CTW
 MEMORY COEFF WAVE)               (* Form 8 bit waveform sample.

							     *)

		(SETQ OUTPUT (fetch
 (MEMORY OUTPUT) of
 MEMORY))
		(SETQ OUTPUT (SPEECH.RANGE.CHECK OUTPUT -127 127)) 
                                                             (* COND ((ILESSP OUTPUT 0) (SETQ OUTPUT 

							     (IDIFFERENCE 127 OUTPUT))))

		(SETA WAVE (IPLUS OFFSET NTIME)
		      OUTPUT])

(SPEECH.CTW

  [LAMBDA (MEMORY COEFF WAVE)                                (* pkh: "29-May-84 12:54")

    (PROG (RESGP RESGZ RESGS REGGP REGGZ REGGS1 REGGS2 AV ASV UGLOTV UGLOT2)
          (SETQ RESGP (fetch
 (COEFF RESGP) of
 COEFF))
          (SETQ RESGZ (fetch
 (COEFF RESGZ) of
 COEFF))
          (SETQ RESGS (fetch
 (COEFF RESGS) of
 COEFF))
          (SETQ REGGP (fetch
 (MEMORY REGGP) of
 MEMORY))
          (SETQ REGGZ (fetch
 (MEMORY REGGZ) of
 MEMORY))
          (SETQ REGGS1 (fetch
 (MEMORY REGGS1) of
 MEMORY))
          (SETQ REGGS2 (fetch
 (MEMORY REGGS2) of
 MEMORY))
          (replace
 (MEMORY NPULSE) of
 MEMORY with
 (SUB1 (fetch
 (MEMORY NPULSE) of
 MEMORY)))
          (replace
 (MEMORY MPULSE) of
 MEMORY with
 (SUB1 (fetch
 (MEMORY MPULSE) of
 MEMORY)))
          (COND
	    ((AND (ILEQ (fetch
 (MEMORY NPULSE) of
 MEMORY)
			0)
		  (IGREATERP (fetch
 (COEFF PULSN) of
 COEFF)
			     1))                             (* End of period. F0 <> 0.0 *)

	      (replace
 (MEMORY NPULSE) of
 MEMORY with
 (fetch
 (COEFF PULSN) of
 COEFF))
	      (replace
 (MEMORY MPULSE) of
 MEMORY with
 (IQUOTIENT (fetch
 (COEFF PULSN) of
 COEFF)
								 2))
	      (SETQ AV (fetch
 (COEFF AV) of
 COEFF))
	      (SETQ ASV (fetch
 (COEFF ASV) of
 COEFF)))
	    (T                                               (* Set AV to 0 between glottal impulses.

							     *)

	       (SETQ AV 0.0)
	       (SETQ ASV 0.0)))                              (* Subtrackt out DC voltage. *)

          [SETQ AV (FDIFFERENCE AV (FQUOTIENT (fetch
 (COEFF AV) of
 COEFF)
					      (fetch
 (COEFF PULSN) of
 COEFF]
          [SETQ ASV (FDIFFERENCE ASV (FQUOTIENT (fetch
 (COEFF ASV) of
 COEFF)
						(fetch
 (COEFF PULSN) of
 COEFF]
                                                             (* GP%, GZ%, GP%, GS. *)

          (SPEECH.UPDATE.RES
 AV RESGP REGGP)
          (SETQ UGLOTV (SPEECH.UPDATE.ANTIRES
 (fetch
 (REG T1) of
 REGGP)
					      RESGZ REGGZ))
          (SPEECH.UPDATE.RES
 ASV RESGS REGGS1)
          (SPEECH.UPDATE.RES
 (fetch
 (REG T1) of
 REGGS1)
			     RESGP REGGS2)                   (* Calc glottal volume velocity.

							     *)

          (replace
 (MEMORY UGLOT1) of
 MEMORY with
 (fetch
 (MEMORY UGLOT) of
 MEMORY))
          (replace
 (MEMORY UGLOT) of
 MEMORY with
 (FPLUS UGLOTV (fetch
 (REG T1) of
 REGGS2)))
          (SPEECH.CTW.TURBULENCE
 MEMORY COEFF)               (* Switch should feed signal to only one of CACADE and 

							     PARALLEL. *)

          (SELECTQ (fetch
 (COEFF SWITCH) of
 COEFF)
		   (CASCADE (SPEECH.CTW.CASCADE
 MEMORY COEFF))
		   (PARALLEL (SPEECH.CTW.PARALLEL
 MEMORY COEFF))
		   (SHOULDNT))
          (SPEECH.CTW.SUM
 MEMORY COEFF)
          (SPEECH.CTW.SCOPE
 MEMORY])

(SPEECH.TRACE

  [LAMBDA (SIGNAL)                                           (* pkh: "29-May-84 12:54")

    (PROG NIL
          (COND
	    ([NOT (MEMB SIGNAL
			'(REG1P REG2P REG3P REG4P REG5P REG6P REGNP REGN REG1C REG2C REG3C REG4C 
				REG5C REG6C REGNPC REGNZC REGGP REGGS1 REGGS2 REGGZ NPULSE MPULSE 
				UGLOT UGLOT1 USUMC UDIF USUMP PLSTEP AFRIC DFRIC UFRIC AASPIR DASPIR 
				UASPIR UCASC UPAR ULIPS OUTPUT]
	      (LISPERROR "Can't trace " SIGNAL)))
          (WINDOWPROP SCOPE.WINDOW 'TITLE (CONCAT "Oscillosope Window: " SIGNAL))
          (SETQ SPEECH.*SIGNAL* SIGNAL])

(SPEECH.CTW.SCOPE

  [LAMBDA (MEMORY)                                           (* pkh: "29-May-84 12:54")

    (PROG (Y)
          (SETQ Y (SELECTQ SPEECH.*SIGNAL*
			   (REG1P (fetch
 (REG T1) of
 (fetch
 (MEMORY REG1P) of
 MEMORY)))
			   (REG2P (fetch
 (REG T1) of
 (fetch
 (MEMORY REG2P) of
 MEMORY)))
			   (REG3P (fetch
 (REG T1) of
 (fetch
 (MEMORY REG3P) of
 MEMORY)))
			   (REG4P (fetch
 (REG T1) of
 (fetch
 (MEMORY REG4P) of
 MEMORY)))
			   (REG5P (fetch
 (REG T1) of
 (fetch
 (MEMORY REG5P) of
 MEMORY)))
			   (REG6P (fetch
 (REG T1) of
 (fetch
 (MEMORY REG6P) of
 MEMORY)))
			   (REGNP (fetch
 (REG T1) of
 (fetch
 (MEMORY REGNP) of
 MEMORY)))
			   (REGN (fetch
 (REG T1) of
 (fetch
 (MEMORY REGN) of
 MEMORY)))
			   (REG1C (fetch
 (REG T1) of
 (fetch
 (MEMORY REG1C) of
 MEMORY)))
			   (REG2C (fetch
 (REG T1) of
 (fetch
 (MEMORY REG2C) of
 MEMORY)))
			   (REG3C (fetch
 (REG T1) of
 (fetch
 (MEMORY REG3C) of
 MEMORY)))
			   (REG4C (fetch
 (REG T1) of
 (fetch
 (MEMORY REG4C) of
 MEMORY)))
			   (REG5C (fetch
 (REG T1) of
 (fetch
 (MEMORY REG5C) of
 MEMORY)))
			   (REG6C (fetch
 (REG T1) of
 (fetch
 (MEMORY REG6C) of
 MEMORY)))
			   (REGNPC (fetch
 (REG T1) of
 (fetch
 (MEMORY REGNPC) of
 MEMORY)))
			   (REGNZC (fetch
 (REG T1) of
 (fetch
 (MEMORY REGNZC) of
 MEMORY)))
			   (REGGP (fetch
 (REG T1) of
 (fetch
 (MEMORY REGGP) of
 MEMORY)))
			   (REGGS1 (fetch
 (REG T1) of
 (fetch
 (MEMORY REGGS1) of
 MEMORY)))
			   (REGGS2 (fetch
 (REG T1) of
 (fetch
 (MEMORY REGGS2) of
 MEMORY)))
			   (REGGZ (fetch
 (REG T1) of
 (fetch
 (MEMORY REGGZ) of
 MEMORY)))
			   (NPULSE (fetch
 (MEMORY NPULSE) of
 MEMORY))
			   (MPULSE (fetch
 (MEMORY MPULSE) of
 MEMORY))
			   (UGLOT (fetch
 (MEMORY UGLOT) of
 MEMORY))
			   (UGLOT1 (fetch
 (MEMORY UGLOT1) of
 MEMORY))
			   (USUMC (fetch
 (MEMORY USUMC) of
 MEMORY))
			   (UDIF (fetch
 (MEMORY UDIF) of
 MEMORY))
			   (USUMP (fetch
 (MEMORY USUMP) of
 MEMORY))
			   (PLSTEP (fetch
 (MEMORY PLSTEP) of
 MEMORY))
			   (AFRIC (fetch
 (MEMORY AFRIC) of
 MEMORY))
			   (DFRIC (fetch
 (MEMORY DFRIC) of
 MEMORY))
			   (UFRIC (fetch
 (MEMORY UFRIC) of
 MEMORY))
			   (AASPIR (fetch
 (MEMORY AASPIR) of
 MEMORY))
			   (DASPIR (fetch
 (MEMORY DASPIR) of
 MEMORY))
			   (UASPIR (fetch
 (MEMORY UASPIR) of
 MEMORY))
			   (UCASC (fetch
 (MEMORY UCASC) of
 MEMORY))
			   (UPAR (fetch
 (MEMORY UPAR) of
 MEMORY))
			   (ULIPS (fetch
 (MEMORY ULIPS) of
 MEMORY))
			   (OUTPUT (fetch
 (MEMORY OUTPUT) of
 MEMORY))
			   (SHOULDNT)))
          (SCOPE.DRAWTO Y)
          (replace
 (MEMORY OUTPUT) of
 MEMORY with
 Y])

(SPEECH.CTW.TURBULENCE

  [LAMBDA (MEMORY COEFF)                                     (* pkh: "29-May-84 12:54")

                                                             (* Turbulence noise of aspiration and fircation.

							     *)

    (PROG (NOISE)
          (SETQ NOISE (SPEECH.CTW.GAUSSIAN
))                 (* Modulate noise during second half of a glottal 

							     period. *)

          [COND
	    ((ILEQ (fetch
 (MEMORY MPULSE) of
 MEMORY)
		   0)
	      (SETQ NOISE (FQUOTIENT NOISE 2.0]              (* Glottal AND frication source volume velocities.

							     *)

          (replace
 (MEMORY AASPIR) of
 MEMORY with
 (FPLUS (fetch
 (MEMORY AASPIR) of
 MEMORY)
							 (fetch
 (MEMORY DASPIR) of
 MEMORY)))
          (replace
 (MEMORY UASPIR) of
 MEMORY with
 (FTIMES (fetch
 (MEMORY AASPIR) of
 MEMORY)
							  NOISE))
          (replace
 (MEMORY AFRIC) of
 MEMORY with
 (FPLUS (fetch
 (MEMORY AFRIC) of
 MEMORY)
							(fetch
 (MEMORY DFRIC) of
 MEMORY)))
          (replace
 (MEMORY UFRIC) of
 MEMORY with
 (FTIMES (fetch
 (MEMORY AFRIC) of
 MEMORY)
							 NOISE])

(SPEECH.CTW.CASCADE

  [LAMBDA (MEMORY COEFF)                                     (* kbr: "16-May-84 13:54")

    (PROG (RES1 RES2 RES3 RES4 RES5 RES6 RESNP RESNZ REG1C REG2C REG3C REG4C REG5C REG6C REGNPC 
		REGNZC REG5P REG6P UCASC)
          (SETQ RES1 (fetch
 (COEFF RES1) of
 COEFF))
          (SETQ RES2 (fetch
 (COEFF RES2) of
 COEFF))
          (SETQ RES3 (fetch
 (COEFF RES3) of
 COEFF))
          (SETQ RES4 (fetch
 (COEFF RES4) of
 COEFF))
          (SETQ RES5 (fetch
 (COEFF RES5) of
 COEFF))
          (SETQ RES6 (fetch
 (COEFF RES6) of
 COEFF))
          (SETQ RESNP (fetch
 (COEFF RESNP) of
 COEFF))
          (SETQ RESNZ (fetch
 (COEFF RESNZ) of
 COEFF))
          (SETQ REG1C (fetch
 (MEMORY REG1C) of
 MEMORY))
          (SETQ REG2C (fetch
 (MEMORY REG2C) of
 MEMORY))
          (SETQ REG3C (fetch
 (MEMORY REG3C) of
 MEMORY))
          (SETQ REG4C (fetch
 (MEMORY REG4C) of
 MEMORY))
          (SETQ REG5C (fetch
 (MEMORY REG5C) of
 MEMORY))
          (SETQ REG6C (fetch
 (MEMORY REG6C) of
 MEMORY))
          (SETQ REGNPC (fetch
 (MEMORY REGNPC) of
 MEMORY))
          (SETQ REGNZC (fetch
 (MEMORY REGNZC) of
 MEMORY))
          (SETQ REG5P (fetch
 (MEMORY REG5P) of
 MEMORY))
          (SETQ REG6P (fetch
 (MEMORY REG6P) of
 MEMORY))
          (replace
 (MEMORY USUMC) of
 MEMORY with
 (FPLUS (fetch
 (MEMORY UGLOT) of
 MEMORY)
							(fetch
 (MEMORY UASPIR) of
 MEMORY)))
                                                             (* Formants. *)

          (COND
	    ((ILESSP (fetch
 (COEFF NCF) of
 COEFF)
		     6)
	      (replace
 (REG T1) of
 REG6C with
 (fetch
 (MEMORY USUMC) of
 MEMORY)))
	    (T (SPEECH.UPDATE.RES
 (fetch
 (MEMORY USUMC) of
 MEMORY)
				  RES6 REG6C)))
          (COND
	    ((ILESSP (fetch
 (COEFF NCF) of
 COEFF)
		     5)
	      (replace
 (REG T1) of
 REG5C with
 (fetch
 (MEMORY USUMC) of
 MEMORY)))
	    (T (SPEECH.UPDATE.RES
 (fetch
 (REG T1) of
 REG6C)
				  RES5 REG5C)))
          (SPEECH.UPDATE.RES
 (fetch
 (REG T1) of
 REG5C)
			     RES4 REG4C)
          (SPEECH.UPDATE.RES
 (fetch
 (REG T1) of
 REG4C)
			     RES3 REG3C)
          (SPEECH.UPDATE.RES
 (fetch
 (REG T1) of
 REG3C)
			     RES2 REG2C)
          (SPEECH.UPDATE.RES
 (fetch
 (REG T1) of
 REG2C)
			     RES1 REG1C)                     (* Nasal. *)

          (SETQ UCASC (SPEECH.UPDATE.ANTIRES
 (fetch
 (REG T1) of
 REG1C)
					     RESNZ REGNZC))
          (SETQ UCASC (SPEECH.UPDATE.RES
 UCASC RESNP REGNPC))
          (replace
 (MEMORY UCASC) of
 MEMORY with
 UCASC)      (* Excite formant resonators F5-F6 with fric noise.

							     *)

          (SPEECH.UPDATE.RES
 (fetch
 (MEMORY UFRIC) of
 MEMORY)
			     RES5 REG5P)
          (SPEECH.UPDATE.RES
 (fetch
 (MEMORY UFRIC) of
 MEMORY)
			     RES6 REG6P])

(SPEECH.CTW.PARALLEL

  [LAMBDA (MEMORY COEFF)                                     (* kbr: "16-May-84 13:54")

                                                             (* Send voicing and frication noise thru parallel 

							     resonators. Increment resonator amplitudes gradually.

							     *)

    (PROG (RES1 RES2 RES3 RES4 RES5 RES6 RESNP REG1P REG2P REG3P REG4P REG5P REG6P REGN UGLOT1)
          (SETQ RES1 (fetch
 (COEFF RES1) of
 COEFF))
          (SETQ RES2 (fetch
 (COEFF RES2) of
 COEFF))
          (SETQ RES3 (fetch
 (COEFF RES3) of
 COEFF))
          (SETQ RES4 (fetch
 (COEFF RES4) of
 COEFF))
          (SETQ RES5 (fetch
 (COEFF RES5) of
 COEFF))
          (SETQ RES6 (fetch
 (COEFF RES6) of
 COEFF))
          (SETQ RESNP (fetch
 (COEFF RESNP) of
 COEFF))
          (SETQ REG1P (fetch
 (MEMORY REG1P) of
 MEMORY))
          (SETQ REG2P (fetch
 (MEMORY REG2P) of
 MEMORY))
          (SETQ REG3P (fetch
 (MEMORY REG3P) of
 MEMORY))
          (SETQ REG4P (fetch
 (MEMORY REG4P) of
 MEMORY))
          (SETQ REG5P (fetch
 (MEMORY REG5P) of
 MEMORY))
          (SETQ REG6P (fetch
 (MEMORY REG6P) of
 MEMORY))
          (SETQ REGN (fetch
 (MEMORY REGN) of
 MEMORY))        (* First formant F1. Excited by voicing only.

							     *)

          (SPEECH.UPDATE.RES
 (FTIMES (fetch
 (COEFF A1) of
 COEFF)
				     (fetch
 (MEMORY UGLOT) of
 MEMORY))
			     RES1 REG1P)                     (* Nasal pole NP. Excited by first diff of voicing 

							     source. *)

          (replace
 (MEMORY UDIF) of
 MEMORY with
 (FDIFFERENCE (fetch
 (MEMORY UGLOT) of
 MEMORY)
							     (fetch
 (MEMORY UGLOT1) of
 MEMORY)))
          (SPEECH.UPDATE.RES
 (FTIMES (fetch
 (COEFF ANP) of
 COEFF)
				     (fetch
 (MEMORY UDIF) of
 MEMORY))
			     RESNP REGN)                     (* Excite formants F2-F4 with fric noise plus first diff

							     voicing. *)

          (replace
 (MEMORY USUMP) of
 MEMORY with
 (FPLUS (fetch
 (MEMORY UDIF) of
 MEMORY)
							(fetch
 (MEMORY UFRIC) of
 MEMORY)))
          (SPEECH.UPDATE.RES
 (FTIMES (fetch
 (COEFF A2) of
 COEFF)
				     (fetch
 (MEMORY USUMP) of
 MEMORY))
			     RES2 REG2P)
          (SPEECH.UPDATE.RES
 (FTIMES (fetch
 (COEFF A3) of
 COEFF)
				     (fetch
 (MEMORY USUMP) of
 MEMORY))
			     RES3 REG3P)
          (SPEECH.UPDATE.RES
 (FTIMES (fetch
 (COEFF A4) of
 COEFF)
				     (fetch
 (MEMORY USUMP) of
 MEMORY))
			     RES4 REG4P)                     (* Excite formant resonators F5-F6 with fric noise.

							     *)

          (SPEECH.UPDATE.RES
 (FTIMES (fetch
 (COEFF A5) of
 COEFF)
				     (fetch
 (MEMORY UFRIC) of
 MEMORY))
			     RES5 REG5P)
          (SPEECH.UPDATE.RES
 (FTIMES (fetch
 (COEFF A6) of
 COEFF)
				     (fetch
 (MEMORY UFRIC) of
 MEMORY))
			     RES6 REG6P])

(SPEECH.CTW.SUM

  [LAMBDA (MEMORY COEFF)                                     (* pkh: "31-May-84 17:10")

                                                             (* Sum up outputs. *)

    (PROG (REG1P REG2P REG3P REG4P REG5P REG6P REGN REGNPC OUTPUT UCASC UPAR)
          (SETQ REG1P (fetch
 (MEMORY REG1P) of
 MEMORY))
          (SETQ REG2P (fetch
 (MEMORY REG2P) of
 MEMORY))
          (SETQ REG3P (fetch
 (MEMORY REG3P) of
 MEMORY))
          (SETQ REG4P (fetch
 (MEMORY REG4P) of
 MEMORY))
          (SETQ REG5P (fetch
 (MEMORY REG5P) of
 MEMORY))
          (SETQ REG6P (fetch
 (MEMORY REG6P) of
 MEMORY))
          (SETQ REGN (fetch
 (MEMORY REGN) of
 MEMORY))
          (SETQ REGNPC (fetch
 (MEMORY REGNPC) of
 MEMORY))    (* Cascade output. *)

          (SETQ UCASC (fetch
 (MEMORY UCASC) of
 MEMORY))      (* Add up outputs from NP%, F1-F6%, and bypass path.

							     *)

          [SETQ UPAR (FPLUS (fetch
 (REG T1) of
 REG1P)
			    (FMINUS (fetch
 (REG T1) of
 REG2P))
			    (fetch
 (REG T1) of
 REG3P)
			    (FMINUS (fetch
 (REG T1) of
 REG4P))
			    (fetch
 (REG T1) of
 REG5P)
			    (FMINUS (fetch
 (REG T1) of
 REG6P))
			    (fetch
 (REG T1) of
 REGN)
			    (FMINUS (FTIMES (fetch
 (COEFF AB) of
 COEFF)
					    (fetch
 (MEMORY UFRIC) of
 MEMORY]
          (replace
 (MEMORY UPAR) of
 MEMORY with
 UPAR)        (* Add cascade and parallel vocal tract outputs.

							     *)

          (replace
 (MEMORY ULIPS) of
 MEMORY with
 (FPLUS UCASC UPAR (fetch
 (MEMORY PLSTEP)
								      of
 MEMORY)))
          (SETQ OUTPUT (FIXR (fetch
 (MEMORY ULIPS) of
 MEMORY)))
          (replace
 (MEMORY PLSTEP) of
 MEMORY with
 (FTIMES PLCONSTANT (fetch
 (MEMORY PLSTEP)
									of
 MEMORY)))
          (replace
 (MEMORY OUTPUT) of
 MEMORY with
 OUTPUT])

(SPEECH.UPDATE.RES

  [LAMBDA (INPUT RES REG)                                    (* pkh: "26-Jun-84 18:06")

                                                             (* Update memory REG. *)

    (PROG (T1 T2 A B C UPDATE)
          (SETQ T1 (REG.T1
 REG))
          (SETQ T2 (REG.T2
 REG))
          (SETQ A (RES.A
 RES))
          (SETQ B (RES.B
 RES))
          (SETQ C (RES.C
 RES))
          (SETQ UPDATE (+$ (x$ A INPUT)
			   (x$ B T1)
			   (x$ C T2)))
          (SETF
 (REG.T2
 REG)
		T1)
          (SETF
 (REG.T1
 REG)
		UPDATE)
          (RETURN UPDATE])

(SPEECH.UPDATE.ANTIRES

  [LAMBDA (INPUT RES REG)                                    (* kbr: "16-May-84 13:54")

                                                             (* Update memory REG. *)

    (PROG (T1 T2 A B C UPDATE)
          (SETQ T1 (fetch
 (REG T1) of
 REG))
          (SETQ T2 (fetch
 (REG T2) of
 REG))
          (SETQ A (fetch
 (RES A) of
 RES))
          (SETQ B (fetch
 (RES B) of
 RES))
          (SETQ C (fetch
 (RES C) of
 RES))
          (SETQ UPDATE (FPLUS (FTIMES A INPUT)
			      (FTIMES B T1)
			      (FTIMES C T2)))
          (replace
 (REG T2) of
 REG with
 T1)
          (replace
 (REG T1) of
 REG with
 INPUT)
          (RETURN UPDATE])

(SPEECH.CTW.GAUSSIAN

  [LAMBDA NIL                                                (* kbr: "16-May-84 13:54")

                                                             (* Pseudo GAUSSIAN *)

    (PROG (GAUSSIAN)
          (SETQ GAUSSIAN 0.0)
          [for
 I from
 1 to
 16 do
 (SETQ GAUSSIAN (FPLUS GAUSSIAN (RAND -.5 .5]
          (RETURN GAUSSIAN])
)
(PUTPROPS COEWAVE.FPKG COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1392 24166 (SPEECH.CREATE.MEMORY 1402 . 2312) (SPEECH.INIT.MEMORY 2314 . 4964) (
SPEECH.INIT.REG 4966 . 5207) (SPEECH.COEFF.TO.WAVE 5209 . 6687) (SPEECH.CTW 6689 . 9677) (SPEECH.TRACE
 9679 . 10266) (SPEECH.CTW.SCOPE 10268 . 13218) (SPEECH.CTW.TURBULENCE 13220 . 14419) (
SPEECH.CTW.CASCADE 14421 . 17445) (SPEECH.CTW.PARALLEL 17447 . 20480) (SPEECH.CTW.SUM 20482 . 22446) (
SPEECH.UPDATE.RES 22448 . 23053) (SPEECH.UPDATE.ANTIRES 23055 . 23785) (SPEECH.CTW.GAUSSIAN 23787 . 
24164)))))
STOP