writesusp.lsp

Audacity是一款用於錄音和編輯聲音的、免費的開放源碼軟體。它可以執行於Mac OS X、Microsoft Windows、GNU/Linux和其它作業系統

    (setf fn-name (format nil "~A_~A_fetch" name encoding))
    (cond (*ANSI*
           (format stream
        "~%~%void ~A(register ~A_susp_type susp, snd_list_type snd_list)~%{~%"
            fn-name name))
          (t
           (format stream
            "~%~%void ~A(susp, snd_list)~%  register ~A_susp_type susp;~%~A~%"
            fn-name name "  snd_list_type snd_list;\n{")))

    ;-----------------------------
    ;    int cnt = 0;  /* how many samples computed */
    ;-----------------------------
    (format stream "    int cnt = 0; /* how many samples computed */~%")

    (dotimes (n (length interp))
      (let ((name (nth n sound-names))
            interpolate-samples
            (method (nth n interp)))
        (setf interpolate-samples
              (not (member (name-to-symbol name) step-function)))

        (cond ((and interpolate-samples (eq method 'INTERP))
               (format stream "    sample_type ~A_x2_sample;~%" name))
              ((eq method 'INTERP))
              ((and interpolate-samples (eq method 'RAMP))
               ;-----------------
               ;    sample_type NAME_DeLtA;
               ;    sample_type NAME_val;
               ;-----------------
               (format stream "    sample_type ~A_DeLtA;~%" name)
               (format stream "    sample_type ~A_val;~%" name)
               (format stream "    sample_type ~A_x2_sample;~%" name))
              ((eq method 'RAMP)
               ;-----------------
               ;    sample_type NAME_val;
               ;-----------------
               (format stream "    sample_type ~A_val;~%" name)))))

    ;-----------------------------
    ;   int togo;
    ;   int n;
    ;   sample_block_type out;
    ;   register sample_block_values_type out_ptr;
    ;   register sample_block_values_type out_ptr_reg;
    ;-----------------------------
    (format stream "    int togo;~%")
    (format stream "    int n;~%")
    (format stream "    sample_block_type out;~%")
    (format stream "    register sample_block_values_type out_ptr;~%~%")
    (format stream "    register sample_block_values_type out_ptr_reg;~%~%")

    ;; computations for DEPENDS variables added to inner loop
    (setf loop-prefix "")
    (dolist (dep depends)
      (dotimes (n (length interp))
        (let ((method (nth n interp))
              (name (nth n sound-names))
              interpolate-samples)
          (setf interpolate-samples
                (not (member (name-to-symbol name) step-function)))
          (cond ((and (equal name (cadr dep))
                      (or (member method '(NONE SCALE))
                          interpolate-samples))
                 (setf loop-prefix (format nil "~A\t    ~A = ~A;~%"
                                    loop-prefix (car dep) (caddr dep))))))))

    ;; computation of JOINT-DEPENDENCY, if applicable
    (setf joint-depend "")
    (dolist (dep (get-slot alg 'joint-dependency))
      ;; if any depended on var is recomputed in inner loop, add the stmts
      (cond ((depended-on-in-inner-loop (car dep) interp sound-names 
                                        step-function)
             (dolist (stmt (cdr dep))
                (setf joint-depend (strcat joint-depend 
                                        "\t    " stmt "\n"))))))

    ; this computes some additional declarations
    (compute-inner-loop alg (strcat loop-prefix joint-depend inner-loop))
    ; make the declarations
    (print-strings (get-slot alg 'register-decl) stream)

    ;-----------------------------
    ;   falloc_sample_block(out, "caller");
    ;  out_ptr = out->samples;
    ;  snd_list->block = out;
    ;-----------------------------
    (format stream "    falloc_sample_block(out, \"~A\");~%" fn-name)
    (format stream "    out_ptr = out->samples;~%")
    (format stream "    snd_list->block = out;~%")

    ;-----------------------------
    ; prime the ramp/interp streams
    ;-----------------------------
    ;; run this code the first time the suspension is called
    (cond ((or (member 'RAMP interp) (member 'INTERP interp))
           (write-prime alg stream interp sound-names)))

    (dotimes (n (length interp))
       (let ((name (nth n sound-names))
             interpolate-samples
             (method (nth n interp)))
         (setf interpolate-samples
               (not (member (name-to-symbol name) step-function)))

         (cond ((or (and interpolate-samples (eq method 'INTERP))
                    (eq method 'RAMP))
                ;-------------
                ;   susp_check_XX_samples(NAME, NAME_ptr, NAME_cnt);
                ;-------------
                (format stream
                        "~%    ~A(~A, ~A_ptr, ~A_cnt);~%"
                        (susp-check-fn name alg) name name name)))

         (cond ((and interpolate-samples (eq method 'INTERP))
                ;-------------
                ;  susp->NAME_x2_sample = susp->NAME->scale * susp->NAME_x2_ptr);
                ;-------------
                (format stream
                 "    ~A_x2_sample = susp_current_sample(~A, ~A_ptr);~%"
                 name name name))
               ((eq method 'INTERP)
                ;-------------
                ;
                ;-------------
                )
               ((and interpolate-samples (eq method 'RAMP))
                ;----------------
                ; susp->NAME_x2_sample = susp_current_sample(NAME, NAME_ptr);
                ;----------------
                (format stream 
                        "    ~A_x2_sample = susp_current_sample(~A, ~A_ptr);~%"
                        name name name))
               ((eq method 'RAMP)
                ))))

    ;----------------------------
    ; *WATCH*: printf("NAME %x new block %x\n", susp, out);
    ;----------------------------
    (if *watch*
      (format stream "    printf(\"~A %x new block %x\\n\", susp, out);~%" name))

    ;----------------------------
    ;    while (cnt < max_sample_block_len)  { /* outer loop */
    ;      /* first compute how many samples to generate in inner loop: */
    ;	   /* don't overflow the output sample block: */
    ;      togo = max_sample_block_len - cnt;
    ;----------------------------
    
    (format stream 
            "~%    while (cnt < max_sample_block_len) { /* outer loop */~%")
    (format stream 
     "\t/* first compute how many samples to generate in inner loop: */~%")
    (format stream
     "\t/* don't overflow the output sample block: */~%")
    (format stream
     "\ttogo = max_sample_block_len - cnt;~%~%")

    ;; this loop gets ready to execute the INNER-LOOP
    (dotimes (n (length interp))
      (let ((name (nth n sound-names))
            interpolate-samples
            (method (nth n interp)))
        (setf interpolate-samples
              (not (member (name-to-symbol name) step-function)))

        (cond ((member method '(NONE SCALE))
               ;-----------------
               ; NONE:
               ;    /* don't run past the NAME input sample block */
               ; susp_check_XX_for_samples(NAME, NAME_ptr, NAME_cnt);
               ;    togo = min(togo, susp->NAME_cnt);
               ;-----------------
               (format stream
                "\t/* don't run past the ~A input sample block: */~%" name)
               (display "don't run past the ..." name (susp-check-fn name alg))
               (format stream
                "\t~A(~A, ~A_ptr, ~A_cnt);~%"
                (susp-check-fn name alg) name name name)
               (format stream "\ttogo = min(togo, susp->~A_cnt);~%~%" name))
              ((eq method 'INTERP))
              ((and interpolate-samples (eq method 'RAMP))
                ;-----------------
                ; RAMP:
                ;
                ;    /* grab next NAME_x2_sample when phase goes past 1.0 */
                ;    /* we use NAME_n (computed below) to avoid roundoff errors: */
                ; if (susp->NAME_n <= 0) {
                ;     susp->NAME_x1_sample = NAME_x2_sample;
                ;     susp->NAME_ptr++;
                ;     susp_took(NAME_cnt, 1);
                ;     susp->NAME_pHaSe -= 1.0;
                ;     susp_check_log_samples(NAME, NAME_ptr, NAME_cnt);
                ;     NAME_x2_sample = susp_current_sample(NAME, NAME_ptr);
                ; }
                ; /* NAME_n gets number of samples before phase exceeds 1.0: */
                ; susp->NAME_n = 0.5 + (long) ((1.0 - susp->NAME_pHaSe) * susp->output_per_NAME);
                ; togo = min(togo, susp->NAME_n);
                ; NAME_DeLtA = (sample_type) ((NAME_x2_sample - susp->NAME_x1_sample) *  susp->NAME_pHaSe_iNcR);
                ; NAME_val = (sample_type) (susp->NAME_x1_sample * (1.0 - susp->NAME_pHaSe) +
                ;      NAME_x2_sample * susp->NAME_pHaSe);
                ;-----------------
                (format stream
                 "\t/* grab next ~A_x2_sample when phase goes past 1.0; */~%" name)
                (format stream
                 "\t/* we use ~A_n (computed below) to avoid roundoff errors: */~%" name)
                (format stream "\tif (susp->~A_n <= 0) {~%" name)
                (format stream "\t    susp->~A_x1_sample = ~A_x2_sample;~%"
                               name name)
                (format stream "\t    susp->~A_ptr++;~%" name);
                (format stream "\t    susp_took(~A_cnt, 1);~%" name);
                (format stream "\t    susp->~A_pHaSe -= 1.0;~%" name);
                (format stream "\t    ~A(~A, ~A_ptr, ~A_cnt);~%"
                 (susp-check-fn name alg) name name name)
                (format stream 
                 "\t    ~A_x2_sample = susp_current_sample(~A, ~A_ptr);~%"
                 name name name)
                (format stream
                 "\t    /* ~A_n gets number of samples before phase exceeds 1.0: */~%"
                        name)
                (format stream 
                        "\t    susp->~A_n = (long) ((1.0 - susp->~A_pHaSe) *~%"
                        name name)
                (format stream "\t\t\t\t\tsusp->output_per_~A);~%\t}~%" name)
                (format stream "\ttogo = min(togo, susp->~A_n);~%" name)
                (format stream "\t~A_DeLtA = (sample_type) ((~A_x2_sample - susp->~A_x1_sample) * susp->~A_pHaSe_iNcR);~%" 
                        name name name name)
                (format stream 
                 "\t~A_val = (sample_type) (susp->~A_x1_sample * (1.0 - susp->~A_pHaSe) +~%"
                 name name name)
                (format stream "\t\t ~A_x2_sample * susp->~A_pHaSe);~%~%"
                         name name))
              ((eq method 'RAMP)
                ;-----------------
                ; SLOW STEP FUNCTION
                ;
                ; /* grab next NAME_x1_sample when phase goes past 1.0 */
                ; /* use NAME_n (computed below) to avoid roundoff errors: */
                ; if (susp->NAME_n <= 0) {
                ;     <fixup depends declarations>
                ;     susp_check_log_samples(NAME, NAME_ptr, NAME_cnt);
                ;     susp->NAME_x1_sample = susp_fetch_sample(NAME, NAME_ptr,
                ; 					       NAME_cnt);
                ;     susp->NAME_pHaSe -= 1.0;
                ;     /* NAME_n gets number of samples before phase 
                ;        exceeds 1.0: */
                ;     susp->NAME_n = (long) ((1.0 - susp->NAME_pHaSe) *
                ;                    susp->output_per_NAME);
                ;     <fixup depends variables>
                ; }
                ; togo = min(togo, susp->NAME_n);
                ; NAME_val = susp->NAME_x1_sample; 
                ;-----------------
                (format stream
                 "\t/* grab next ~A_x1_sample when phase goes past 1.0; */~%"
                 name)
                (format stream
                "\t/* use ~A_n (computed below) to avoid roundoff errors: */~%"
                 name)
                (format stream "\tif (susp->~A_n <= 0) {~%" name)
                (fixup-depends-prime-decls alg stream name)
                (format stream "\t    ~A(~A, ~A_ptr, ~A_cnt);~%"
                 (susp-check-fn name alg) name name name)
                (format stream 
          "\t    susp->~A_x1_sample = susp_fetch_sample(~A, ~A_ptr, ~A_cnt);~%"
                 name name name name)
                (format stream "\t    susp->~A_pHaSe -= 1.0;~%" name);
                (format stream
          "\t    /* ~A_n gets number of samples before phase exceeds 1.0: */~%"
                        name)
                (format stream 
                 "\t    susp->~A_n = (long) ((1.0 - susp->~A_pHaSe) *~%"
                        name name)
                (format stream "\t\t\t\t\tsusp->output_per_~A);~%" name)
                (fixup-depends-prime alg stream name "\t    "
                        (strcat "susp->" name "_x1_sample"))
                (format stream "\t}~%" name)
                (format stream "\ttogo = min(togo, susp->~A_n);~%" name)
                (format stream 
                 "\t~A_val = susp->~A_x1_sample;~%" name name) ))))
    
    ;---------------
    ; see if there are joint-dependencies that should be output now
    ; output here if none of depended-on signals are updated in inner loop
    ;---------------
    ;; computation of JOINT-DEPENDENCY, if applicable
    (setf joint-depend "")
    (dolist (dep (get-slot alg 'joint-dependency))
      (cond ((not (depended-on-in-inner-loop (car dep) interp sound-names 
                                             step-function))
             (dolist (stmt (cdr dep))
                (setf joint-depend (strcat joint-depend 
                                        "\t" stmt "\n"))))))
    (setf joint-depend (fixup-substitutions-prime alg joint-depend nil nil))
    (format stream joint-depend)

    ;----------------
    ; if the teminate time is a MIN of some signals or AT some expression
    ; (i.e. specified at all) see if we're coming to the terminate cnt:
    ;
    ;	/* don't run past terminate time */
    ;	if (susp->terminate_cnt != UNKNOWN && 
    ;		susp->terminate_cnt <= susp->susp.current) {
    ;	    int to_stop = (susp->terminate_cnt + max_sample_block_len) -
    ;			 (susp->susp.current + cnt);
    ;	    if (to_stop < togo && ((togo = to_stop) == 0)) break;
    ;	}
    ;----------------
    (cond ((terminate-check-needed terminate alg)
           (print-strings '(
     "\t/* don't run past terminate time */\n"
     "\tif (susp->terminate_cnt != UNKNOWN &&\n"
     "\t    susp->terminate_cnt <= susp->susp.current + cnt + togo) {\n"
     "\t    togo = susp->terminate_cnt - (susp->susp.current + cnt);\n"
     "\t    if (togo == 0) break;\n"
     "\t}\n\n") stream)))

    ;----------------
    ; if the logical-stop attribute is MIN of some signals or AT some expression
    ; see if we're coming to the logical stop:
    ;
    ;   /* don't run past logical stop time */
    ;	if (!susp->logically_stopped && susp->susp.log_stop_cnt != UNKNOWN) {
    ;	    int to_stop = susp->susp.log_stop_cnt - (susp->susp.current + cnt);
    ;           /* break if to_stop == 0 (we're at the logical stop)
    ;	     * AND cnt > 0 (we're not at the beginning of the
    ;	     * output block).
    ;	     */