Locate and position the current Audacity source code, and clear a variety of old junk out of the way into junk-branches

nyquist/misc.lsp

@@ -0,0 +1,154 @@
+;## misc.lsp -- a collection of useful support functions
+
+;; Garbage collection "improvement" -- XLISP will GC without allocation
+;; as long as it does not run out of cells. This can make it very slow
+;; since GC does work proportional to the heap size. If there were
+;; always at least, say, 1/3 of the heap free after GC, then allocating
+;; cells would be more-or-less a constant time operation (amortized).
+;;
+;; So, after GC, we'll expand until we have 1/3 of the heap free.
+;;
+(defun ny:gc-hook (heap-size free-cells)
+  (cond ((< (* free-cells 2) heap-size) ;; free cells is < 1/3 heap
+         ;; expand. Each expansion unit is 2000 cons cells
+         (let* ((how-many-not-free (- heap-size free-cells))
+                (should-be-free (/ how-many-not-free 2))
+                (how-many-more (- should-be-free free-cells))
+                (expand-amount (/ how-many-more 2000)))
+           (cond ((> expand-amount 0)
+                  (if *gc-flag*
+                      (format t
+                       "[ny:gc-hook allocating ~A more cells] "
+                       (* expand-amount 2000)))
+                  (expand expand-amount)))))))
+
+(setf *gc-hook* 'ny:gc-hook)
+
+
+; set global if not already set
+;
+(defmacro init-global (symb expr)
+  `(if (boundp ',symb) ,symb (setf ,symb ,expr)))
+
+; enable or disable breaks
+(defun bkon () (setq *breakenable* T))
+(defun bkoff () (setq *breakenable* NIL))
+
+(bkon)
+
+;; (grindef 'name) - pretty print a function
+;;
+(defun grindef (e) (pprint (get-lambda-expression (symbol-function e))))
+
+;; (args 'name) - print function and its formal arguments
+;;
+(defun args (e) 
+  (pprint (cons e (second (get-lambda-expression (symbol-function e))))))
+
+;; (incf <place>), (decf <place>) - add/sub 1 to/from variable
+;;
+(defmacro incf (symbol) `(setf ,symbol (1+ ,symbol)))
+(defmacro decf (symbol) `(setf ,symbol (1- ,symbol)))
+
+
+;; (push val <place>) - cons val to list
+;;
+(defmacro push (val lis) `(setf ,lis (cons ,val ,lis)))
+(defmacro pop (lis) `(prog1 (car ,lis) (setf ,lis (cdr ,lis))))
+
+;; include this to use RBD's XLISP profiling hooks
+;;(load "/afs/andrew/usr/rbd/lib/xlisp/profile.lsp")
+
+;(cond ((boundp 'application-file-name)
+;       (load application-file-name)))
+
+
+(defun get-input-file-name ()
+  (let (fname)
+    (format t "Input file name: ")
+    (setf fname (read-line))
+    (cond ((equal fname "") (get-input-file-name))
+          (t fname))))
+
+
+(defun open-output-file ()
+  (let (fname)
+    (format t "Output file name: ")
+    (setf fname (read-line))
+    (cond ((equal fname "") t)
+          (t (open fname :direction :output)))))
+
+
+(defmacro while (cond &rest stmts)
+  `(prog () loop (if ,cond () (return)) ,@stmts (go loop)))
+
+
+; when parens/quotes don't match, try this
+; 
+(defun file-sexprs ()
+  (let ((fin (open (get-input-file-name)))
+        inp)
+    (while (setf inp (read fin)) (print inp))))
+
+;; get path for currently loading file (if any)
+;;
+(defun current-path ()
+  (let (fullpath n)
+    (setf n -1)
+    (cond (*loadingfiles*
+           (setf fullpath (car *loadingfiles*))
+           (dotimes (i (length fullpath))
+             (cond ((equal (char fullpath i) *file-separator*)
+                    (setf n i))))
+           (setf fullpath (subseq fullpath 0 (1+ n)))
+
+;;         REMOVED SUPPORT FOR MAC OS-9 AND BELOW -RBD
+           ;; if this is a Mac, use ':' in place of empty path
+;;           (cond ((and (equal fullpath "") 
+;;                       (equal *file-separator* #\:))
+;;                  (setf fullpath ":")))
+;;         END MAC OS-9 CODE
+
+           ;; Here's an interesting problem: fullpath is now the path
+           ;; specified to LOAD, but it may be relative to the current
+           ;; directory. What if we want to load a sound file from the
+           ;; current directory? It seems that S-READ gives priority to
+           ;; the *DEFAULT-SF-DIR*, so it will follow fullpath STARTING
+           ;; FROM *DEFAULT-SF-DIR*. To fix this, we need to make sure
+           ;; that fullpath is either an absolute path or starts with
+           ;; and explicit ./ which tells s-read to look in the current
+           ;; directory.
+           (cond ((> (length fullpath) 0)
+		  (cond ((full-name-p fullpath))
+			(t ; not absolute, make it explicitly relative
+			 (setf fullpath (strcat "./" fullpath)))))
+                 (t (setf fullpath "./"))) ; use current directory
+           fullpath)
+          (t nil))))
+          
+;; real-random -- pick a random real from a range
+;;
+(defun real-random (from to)
+  (+ (* (rrandom) (- to from)) from))
+
+;; power -- raise a number to some power x^y
+;;
+(defun power (x y)
+  (exp (* (log (float x)) y)))
+  
+;; require-from -- load a file if a function is undefined
+;;
+;; fn-symbol -- the function defined when the file is loaded
+;; file-name -- the name of file to load if fn-symbol is undefined
+;; path -- if t, load from current-path; if a string, prepend string
+;;         to file-name; if nil, ignore it
+;;
+(defmacro require-from (fn-symbol file-name &optional path)
+  (cond ((eq path t)
+         (setf file-name `(strcat (current-path) ,file-name)))
+        (path
+         (setf file-name `(strcat ,path ,file-name))))
+  `(if (fboundp (quote ,fn-symbol))
+       t
+       (load ,file-name)))
+