diff -pruN 19-1/clm2xen.c 19.0-1/clm2xen.c --- 19-1/clm2xen.c 2018-11-23 11:33:45.000000000 +0000 +++ 19.0-1/clm2xen.c 2018-12-07 22:11:01.000000000 +0000 @@ -408,11 +408,12 @@ Xen mus_optkey_to_procedure(Xen key, con /* ---------------- clm keywords ---------------- */ #if HAVE_SCHEME -static s7_pointer kw_frequency, kw_radius; +static s7_pointer kw_frequency, kw_radius, kw_readable; static void init_keywords(void) { kw_frequency = Xen_make_keyword("frequency"); kw_radius = Xen_make_keyword("radius"); + kw_readable = Xen_make_keyword("readable"); } #else @@ -1331,7 +1332,7 @@ static s7_pointer mus_generator_to_strin { s7_pointer choice; choice = s7_cadr(args); - if (choice == s7_make_keyword(sc, "readable")) + if (choice == kw_readable) s7_error(sc, s7_make_symbol(sc, "out-of-range"), s7_list(sc, 1, s7_make_string(sc, "can't write a clm generator readably"))); } return(s7_make_string(sc, mus_describe(((mus_xen *)s7_c_object_value(g))->gen))); diff -pruN 19-1/clm.html 19.0-1/clm.html --- 19-1/clm.html 2018-11-23 11:33:45.000000000 +0000 +++ 19.0-1/clm.html 1970-01-01 00:00:00.000000000 +0000 @@ -1,4564 +0,0 @@ - - - - - -CLM - - - - - - -
CLM
- -

CLM (originally an acronym for Common Lisp Music) is a sound synthesis -package in the Music V family. It provides much the same functionality as -Stk, Csound, SuperCollider, PD, CMix, cmusic, and Arctic — a collection of functions -that create and manipulate sounds, aimed primarily at composers (in CLM's -case anyway). The instrument builder plugs together these functions -(called generators here), along with general programming glue to -make computer instruments. These are then called in a note list -or through some user interface (provided by Snd, for example). -

- -

-CLM exists in several forms: -the original Common Lisp implementation (clm-5.tar.gz), -a C version (sndlib.tar.gz), -a Scheme version (sndlib.tar.gz with s7), Ruby (sndlib again but using Ruby), -and Forth (sndlib). The Scheme, Ruby, and Forth versions are also built into -the Snd editor (snd-17.tar.gz). -This document is aimed at the Common Lisp version in clm-5.tar.gz. See sndclm.html -in the Snd tarball for the Scheme/Ruby/Forth/C version (sndclm.html has much more -information than this file). -There are a variety of unavoidable differences between these -versions, but in general, the differences are obvious and consistent: Lisp "-" becomes -C "_", "?" becomes "_p", "->" becomes "_to_", and so on, so the function -named mus_oscil in C, becomes oscil elsewhere, mus_oscil_p becomes oscil?, -and mus_hz_to_radians becomes hz->radians in Lisp/Scheme. -If you'd like to compare -a standard instrument in the various implementations, check out the -fm-violin: v.ins (Common Lisp), v.scm (Scheme), v.rb (Ruby), clm-ins.fs (Forth), -and sndlib.html (C). -

- -

CLM has several sections: "generators", instruments -(definstrument and *.ins), examples of note lists -(with-sound, *.clm), a "make" facility for sound files (with-mix), -and various functions that are useful in sound file work. -CLM is available free, via anonymous ftp (pub/Lisp/clm-5.tar.gz at -ccrma-ftp.stanford.edu). -

- -
Bill Schottstaedt (bil@ccrma.stanford.edu)
- - - - -
Contents
- - - - - -
Introduction
- -

CLM provides functions to experiment with sounds. -The easiest way to make a new sound is -with-sound. Say we want to hear one second of the fm violin (in v.ins, -named fm-violin) at 440 Hz, and a somewhat soft amplitude. Compile v.ins and load v, then call with-sound:

- -
-(compile-file "v.ins")
-(load "v")
-(with-sound () (fm-violin 0 1 440 .1)) 
-
- -

and the note should emerge from the speakers. (In CMU-CL, load v.cmucl, not v.x86f). The compile and load sequence can be abbreviated -in most lisps. -Once loaded, we don't -need to reload v unless we change it in some way. -To get an arpeggio:

- -
-(with-sound ()
-  (loop for i from 0 to 7 do
-    (fm-violin (* i .25) .5 (* 100 (1+ i)) .1))) 
-
- -

clm-example.lisp shows how to create such a note list algorithmically. -To listen to the last computed sound again: -

- -
-(play)
-
- -

or, if you have some saved sound file: -

- -
-(play "a-great.snd")
-
- -

Although you can use CLM simply as a bunch of canned functions, it's a lot more -fun to make your own. In CLM, these are called instruments, and a sequence of -instrumental calls is a note list. -To create your own instrument, you need to write the function that expresses -in CLM's terms the sound processing actions you want. -In the simplest case, you can just calculate your new -value, and add it into the current output:

- -
-(definstrument simp (start-time duration frequency amplitude)
-  (let* ((beg (floor (* start-time *srate*)))
-	 (end (+ beg (floor (* duration *srate*))))
-	 (j 0))
-    (run
-      (loop for i from beg below end do
-        (outa i (* amplitude (sin (* j 2.0 pi (/ frequency *srate*)))))
-	(incf j)))))
-
- -

Now to hear our sine wave, place this code in a file, say simp.ins, compile and load it, then:

- -
-(with-sound () (simp 0 0.25 440.0 0.2))
-
- -

This creates a sine-wave at 440.0 Hz, 0.2 amplitude, between times 0 and -0.25 seconds. The line:

- -
-(definstrument simp (start-time duration frequency amplitude) 
-
- -

says that we are defining an instrument (via definstrument) named simp which -takes the four parameters start-time, duration, frequency, and amplitude. -The next two lines:

- -
-(let* ((beg (floor (* start-time *srate*)))
-       (end (+ beg (floor (* duration *srate*))))) 
-
- -

turn the start-time and duration values, passed by the caller in -terms of seconds, into samples. The variable *srate* -holds the current sampling rate. -The "run" macro is an optimizer; -it turns its body into a C foreign function call. -The next -line:

- -
-(loop for i from beg below end and j from 0 by 1 do 
-
- -

uses the Lisp loop construct to loop through the samples -between the start time in samples (beg) and the end point (end) calculating -simp's output on each sample. We are also using the variable j -to increment the current phase in the last line:

- -
-(outa i (* amplitude (sin (* j 2.0 pi (/ frequency *srate*)))))))) 
-
- -

This is the heart of our instrument. The call (outa i ...) -adds its third argument (in this case a complicated expression) into channel 0 of the -current output stream at sample i. The expression:

- -
-(* amplitude (sin (* j 2.0 pi (/ frequency *srate*)))))))) 
-
- -

is creating a sinusoid (via the "sin" function) at the specified -volume ("amplitude" is passed as an argument to simp), and the -desired frequency ("frequency" is also an argument to simp). The -caller passes simp a frequency in cycles per second (440.0 for -example), but we need to turn that into the corresponding phase -value for the "sin" function. We do that by translating from -cycles per second to radians per sample by multiplying by two pi -(this multiply gives us radians -per second), then dividing by the sampling rate (samples per -second) to give us radians per sample (i.e. radians/second -divided by samples/second gives radians/sample); we then multiply -by "j" to step forward on each sample. -Finally, the line:

- -
-(with-sound () (simp 0 0.25 440.0 0.2))
-
- -

opens an output sound file, calls simp, closes the file, and -plays the result. -We need to put the instrument definition in a separate file -and compile and load it; we can't just paste it into the listener (this limitation applies only to the Common Lisp CLM). -

- -

We can simplify simp by using oscil for the sinusoid and -hz->radians. make-oscil creates an oscil generator; -similarly make-env creates an envelope generator: -

- -
-(definstrument simp (start-time duration frequency amplitude &optional (amp-env '(0 0 .5 1.0 1.0 0)))
-  (multiple-value-bind (beg end) (times->samples start-time duration)
-    (let ((osc (make-oscil :frequency frequency))
-	  (amp-env (make-env amp-env :scaler amplitude :duration duration)))
-      (run 
-       (loop for i from beg below end do
-	 (outa i (* (env amp-env) (oscil osc))))))))
-
- -

Our envelope is a list of (x y) break-point pairs. The -x-axis bounds are arbitrary, but it is conventional (here at ccrma) to -go from 0 to 1.0. The y-axis values are normally between -1.0 and -1.0, to make it easier to figure out how to apply the envelope in -various different situations. In this case, our envelope is a ramp up -to the middle of the note: "(0.0 0.0 0.5 1.0)", then a ramp down to 0. -The env generator produces the envelope on a sample-by-sample -basis. -

- -

If you make a change to an instrument, just recompile and reload it to -use the changed version; there's no need to restart lisp, or unload the old version (in most -lisps there's actually no way to unload it). -

- - -
Instruments
- -

The normal structure of an instrument is:

- -
-(definstrument name (args) (setup code (run run-time code)))
-
- -

The setup code creates any needed generators for the -run-time code which actually generates the samples. -The run-time code can contain any of the lisp functions (generators etc) -described in the next several sections. Since life is short, -not every feature of lisp is supported by the run macro; -I've concentrated on those that have been useful in the past, so let me know -if you need something new! -

- - - -

Lisp functions that can occur within the body of the run macro:

- -
-+  /  *  -  1+  1-  incf decf setf setq
- =  /=  <  >  <=  >=  zerop plusp  
-minusp oddp evenp max min abs mod rem identity
-floor ceiling round truncate signum sqrt random float
-ash log expt exp sin cos tan asin acos atan cosh sinh tanh asinh acosh atanh
-erf erfc lgamma bes-j0 bes-j1 bes-jn bes-y0 bes-y1 bes-yn bes-i0
-or and not null if unless when cond progn prog1 prog2 case tagbody go 
-error warn print princ terpri probe-file
-block return return-from let let* loop do do* dotimes declare
-lambda apply loop-finish
-aref elt svref array-total-size array-in-bounds-p array-rank array-dimension
-integerp numberp floatp realp eq eql arrayp
-
- -

The function clm-print stands in for Lisp's -format — I don't support all of format's -options, but enough to be useful, I hope. clm-print's syntax is (clm-print -format-string &rest args). It is also possible to write to a file: -

- -
-(definstrument fileit ()
-  (let ((file (c-open-output-file "test.clm-data")))
-    (run
-     (loop for i from 0 to 10 do
-       (clm-print file "hiho ~D " i)))
-    (c-close file)))
-
- -

-Loop is expanded as a macro and anything in -the loop syntax is ok if it expands into something else mentioned above (i.e. a -lambda form with go's and so forth). -

- -

-Declare can be used to set the variable types and debugging options. -Since the run macro can't always tell what type a variable is, it will -generate run-time code to figure out the type. The generated code will -be faster and tighter (and a lot easier to read) if you use declare to -tell run what the types are. -In Common Lisp, the recognized types are :integer, :float, :string, :boolean, :bignum (sample number), -:double*, :int*, :mus-any, and :mus-any* (the keyword package -is used to avoid endless CL package name troubles). -

- - - - -
Generators
- - - - -
- - - - - - - - - - - - - - - - - - - - - - -
all-passall-pass filter
asymmetric-fmasymmetric fm
combcomb filter
convolveconvolution
delaydelay line
envline segment envelope
filterdirect form FIR/IIR filter
filtered-combcomb filter with filter on feedback
fir-filterFIR filter
formantresonance
granulategranular synthesis
iir-filterIIR filter
in-anysound file input
locsigstatic sound placement
move-soundsound motion
moving-averagemoving window average
ncossum of equal amplitude cosines
notchnotch filter
nsinsum of equal amplitude sines
nrxycossum of n scaled cosines
nrxysinsum of n scaled sines
-
- - - - - - - - - - - - - - - - - - - - -
one-poleone pole filter
one-zeroone zero filter
oscilsine wave and FM
out-anysound output
polywave and polyshapewaveshaping
phase-vocodervocoder analysis and resynthesis
pulse-trainpulse train
rand,rand-interprandom numbers, noise
readinsound input
sawtooth-wavesawtooth
square-wavesquare wave
srcsampling rate conversion
ssb-amsingle sideband amplitude modulation
table-lookupinterpolated table lookup
tapdelay line tap
triangle-wavetriangle wave
two-poletwo pole filter
two-zerotwo zero filter
wave-trainwave train
-
- - - -

A generator is a function that returns the next sample in an infinite stream of samples -each time it is called. An oscillator, for example, returns an endless sine wave, one sample -at a time. -Each generator consists of a set of functions: Make-<gen> sets up the -data structure associated with the generator at initialization time; -<gen> produces a new sample; -<gen>? checks whether a variable is that kind of generator. -Internal fields are accessible via various generic functions such as mus-frequency. -

- -
-(setf oscillator (make-oscil :frequency 330))
-
- -

prepares oscillator to produce a sine wave -when set in motion via

- -
-(oscil oscillator)
-
- -

(oscil? oscillator) returns t, and (mus-frequency oscillator) returns 330. -The initialization function (make-oscil above) -normally takes a number of optional arguments, setting whatever choices need to be made to specify the -generator's behavior. The run-time function (oscil above) always takes the generator as its first argument. -Its second argument is nearly always -something like an FM input; in a few cases, it is a function to provide input data or editing operations. -Frequency sweeps of all kinds (vibrato, glissando, breath -noise, FM proper) are all forms of run-time frequency modulation. So, in -normal usage, our oscillator looks something like:

- -
-(oscil oscillator (+ vibrato glissando frequency-modulation))
-
- -

-Frequencies are always in cycles per -second (also known as Hz). The -FM (or frequency change) argument is assumed to be a phase change in radians, -applied on each sample. Normally composers would rather think in terms of -Hz, so the function hz->radians can be used to convert from units of cycles -per second to radians per sample. -

- -

Finally, one special aspect of the make-<gen> functions is the way they -read their arguments. I use the word optional-key -in the function definitions in this document to indicate that the arguments are -keywords, but the keywords themselves are optional. -Take the make-oscil call, defined as:

- -
-make-oscil &optional-key (frequency 0.0) (initial-phase 0.0)
-
- -

When make-oscil is called, it scans its arguments; if a keyword is seen, that -argument and all following arguments are passed unchanged, but if a value is -seen, the corresponding keyword is prepended in the argument list: -

- -
-(make-oscil :frequency 440.0)
-(make-oscil :frequency 440.0 :initial-phase 0.0)
-(make-oscil 440.0)
-(make-oscil)
-(make-oscil 440.0 :initial-phase 0.0)
-(make-oscil 440.0 0.0)
-
- -

are all equivalent, but

- -
-(make-oscil :frequency 440.0 0.0)
-(make-oscil :initial-phase 0.0 440.0)
-
- -

are in error, because once we see any keyword, all the rest of the arguments have -to use keywords too (we can't reliably make any assumptions after that point about argument -ordering). If this is confusing, just use the keywords all the time. I implemented this somewhat -unusual argument interpretation because -in many cases it is silly to insist on the keyword; for example, in make-env, -the envelope argument is obvious and can't be confused with any other argument, so -it's an annoyance to have to say ":envelope" over and over. Keyword arguments are also -useful when there are so many arguments to a function that it becomes impossible to -remember what they are and what order they come in. -

- - - - - -
oscil
- -
-make-oscil &optional-key (frequency 0.0) (initial-phase 0.0)
-oscil os &optional (fm-input 0.0) (pm-input 0.0)
-oscil? os
-
- -

oscil produces a sine wave (using sin) with optional frequency change (i.e. FM). -Its first argument is an oscil created by make-oscil. -Oscil's second (optional) argument is the current (sample-wise) -frequency change. The optional third argument is the (sample-wise) -phase change (in addition to the carrier increment and so on). -So the second argument can be viewed as FM, while the third is PM (phase modulation). -The initial-phase argument to make-oscil is in radians. You can -use degrees->radians to convert from degrees to radians. -To get a cosine (as opposed to sin), set the initial-phase to (/ pi 2): -(make-oscil 440.0 (/ pi 2)) . -

- - - - - - - -
oscil methods
mus-frequency frequency in Hz
mus-phase phase in radians
mus-length 1 (no setf)
mus-increment frequency in radians per sample
- -

Oscil might be defined: -

-
-  (prog1
-    (sin (+ phase pm-input))
-    (incf phase (+ (hz->radians frequency) fm-input)))
-
- -

oscil takes both FM and PM arguments; here is an example of FM: -

- -
-(definstrument simple-fm (beg dur freq amp mc-ratio index &optional amp-env index-env)
-  (let* ((start (floor (* beg *srate*)))
-	 (end (+ start (floor (* dur *srate*))))
-	 (cr (make-oscil freq))                     ; our carrier
-         (md (make-oscil (* freq mc-ratio)))        ; our modulator
-         (fm-index (hz->radians (* index mc-ratio freq)))
-         (ampf (make-env (or amp-env '(0 0 .5 1 1 0)) :scaler amp :duration dur))
-         (indf (make-env (or index-env '(0 0 .5 1 1 0)) :scaler fm-index :duration dur)))
-    (run
-      (loop for i from start to end do
-        (outa i (* (env ampf) (oscil cr (* (env indf) (oscil md)))))))))
-
- - -

See cl-fm.html for a -discussion of FM. The standard additive synthesis instruments use an array of oscillators to -create the individual spectral components: -

- -
-(definstrument simple-osc (beg dur freq amp)
-  (let* ((start (floor (* beg *srate*)))
-	 (end (+ start (floor (* dur *srate*))))
-	 (arr (make-array 20))) ; we'll create a tone with 20 harmonics
-    (do ((i 0 (1+ i)))
-	((= i 20))
-      (setf (aref arr i) (make-oscil (* (1+ i) 100))))
-    (run
-     (loop for i from start to end do
-       (let ((sum 0.0))
-	 (do ((i 0 (1+ i)))
-	     ((= i (length arr)))
-	   (incf sum (oscil (aref arr i))))
-	 (outa i (* amp .05 sum)))))))
-
- - - - - - - - - -
env
- -
-make-env &optional-key 
-      envelope      ; list of x,y break-point pairs
-      (scaler 1.0)  ; scaler on every y value (before offset is added)
-      duration      ; seconds
-      (offset 0.0)  ; value added to every y value
-      base          ; type of connecting line between break-points
-      end           ; end point in samples (similar to dur)
-      length        ; duration in samples (can be used instead of end)
-env e
-env? e
-env-interp x env &optional (base 1.0)
-envelope-interp x envelope &optional (base 1.0)
-
- - - - - - - - - -
env methods
mus-location call counter value (number of calls so far on env)
mus-incrementbase value (no setf)
mus-data original breakpoint list
mus-scaler original scaler
mus-offset original offset
mus-length original duration in samples
- -

An envelope is a list of break point pairs: '(0 0 100 1) is -a ramp from 0 to 1 over an x-axis excursion from 0 to 100 (that is, we have (x0 y0 x1 y1), so -we're going from (0, 0) to (100, 1)). -This list is passed -to make-env along with the scaler -applied to the y axis, the offset added to every y value, -and the time in samples or seconds that the x axis represents. make-env -returns an env generator which returns the next sample of the envelope each -time it is called. The actual envelope value, leaving aside the base -is offset + scaler * envelope-value. -

- -

-The kind of interpolation used to get y-values between the break -points (the connecting curve) is determined by the envelope's base. -The default (base = 1.0) gives a straight line connecting the points. -Say we want a ramp moving from .3 to .5 over 1 second. -The corresponding make-env call would be -

- -
-(make-env '(0 0 100 1) :scaler .2 :offset .3 :duration 1.0)
-or
-(make-env '(0 .3 1 .5) :duration 1.0)
-
- - -

base = 0.0 gives a step -function (the envelope changes its value suddenly to the new one without any -interpolation). Any other positive value becomes the exponent of the exponential curve -connecting the points. base < 1.0 gives convex curves (i.e. bowed -out), and base > 1.0 gives concave curves (i.e. sagging). -If you'd rather think in terms of e^-kt, set the base to (exp k). -To get arbitrary connecting curves between the break points, treat -the output of env as the input to the connecting function. Here's an -instrument that maps the line segments into sin x^3: -

- -
-(definstrument mapenv (beg dur frq amp en)
-  (let* ((start (floor (* beg *srate*)))
-	 (end (+ start (floor (* dur *srate*))))
-	 (osc (make-oscil frq))
-         (half-pi (* pi 0.5))
-	 (zv (make-env en 1.0 dur)))
-    (run
-     (loop for i from start below end do
-       (let ((zval (env zv))) ; zval^3 is [0.0..1.0], as is sin between 0 and half-pi.
-	 (outa i (* amp (sin (* half-pi zval zval zval)) (oscil osc))))))))
-
-(with-sound () (mapenv 0 1 440 .4 '(0 0 50 1 75 0 86 .5 100 0)))
-
- - -

Or create your own generator that traces out the curve you want. -J.C.Risset's bell curve could be:

- -
-(defmacro bell-curve (x)
-  ;; x from 0.0 to 1.0 creates bell curve between .64e-4 and nearly 1.0
-  ;; if x goes on from there, you get more bell curves; x can be
-  ;; an envelope (a ramp from 0 to 1 if you want just a bell curve)
-  `(+ .64e-4 (* .1565 (- (exp (- 1.0 (cos (* two-pi ,x)))) 1.0))))
-
- -

mus-reset of an envelope causes it -to start all over again from the beginning. To jump to any position in -an envelope, use mus-location. -

- -

This instrument repeats the same envelope over and over: -

- -
-(definstrument strummer (beg dur env-dur)
-  (let* ((os (make-oscil))
-	 (e (make-env '(0 0 50 1 100 0) :length env-dur :scaler .1)))
-    (run
-     (loop for i from beg below (+ beg dur) do 
-       (if (> (mus-location e) (mus-length e))
-           (mus-reset e))
-       (outa i (* (env e) (oscil os)))))))
-
-;;; (with-sound () (strummer 0 22050 2000))
-
- -

env-interp and envelope-interp return the value of the envelope at some point -on the x axis; env-interp operates on an 'env' (the output of make-env), whereas -envelope-interp operates on an 'envelope' (a list of breakpoints). -To get weighted random numbers, use the output of -(random 100.0) as the lookup index into an envelope whose x axis goes -from 0 to 100. Then the envelope y values are the numbers returned, -and the amount of the x-axis taken by a given value is its weight. -Say we want 40% .5, and 60% 1.0, -

- -
-(loop for i from 0 to 10 collect 
-  (envelope-interp (random 100.0) (list 0 .5 40 .5 40.01 1.0 100 1.0)))
-=> '(1.0 1.0 0.5 1.0 1.0 0.5 0.5 1.0 0.5 1.0 1.0) 
-
- -

This idea is also available in the rand and rand-interp generators. -Other env-related functions are:

- - - - - - - - - - - - - - - -
envelope-reverse ereverse an envelope
envelope-repeat e num &optional refl xnormrepeat an envelope
envelope-concatenate &rest esconcatenate any number of envelopes
envelope+ esadd together any number of envelopes
envelope* essame but multiply
envelope-simplify e &optional yg xgsimplify an evelope
meld-envelopes e0 e1meld two envelopes together
map-across-envelopes func esmap a function across any number of envelopes
envelope-exp e &optional pow xgcreate exponential segments of envelopes
window-envelope beg end ereturn portion of e between two x values
stretch-envelope e a0 a1 &optional d0 d1attack and decay portions
scale-envelope e scale &optional offsetscale e
normalize-envelope e &optional normnormalize e
- -

See env.lisp for more such functions. To copy an existing envelope while changing one aspect (say -duration), it's simplest to use make-env: -

- -
-(defun change-env-dur (e dur)
-  (make-env (mus-data e)            ; the original breakpoints
-	    :scaler (mus-scaler e)  ; these are the original values passed to make-env
-	    :offset (mus-offset e)
-            :base (mus-increment e) ; the base (using "mus-increment" because it was available...)
-	    :duration dur))
-
- - - - - - -
table-lookup
- -
-make-table-lookup &optional-key 
-        (frequency 0.0)   ; in Hz
-        (initial-phase 0.0) ; in radians 
-        wave                ; double-float array
-        size                ; table size if wave not specified
-        type                ; interpolation type (mus-interp-linear)
-table-lookup tl &optional (fm-input 0.0)
-table-lookup? tl
-
- - -

table-lookup performs interpolating table lookup. Indices are first -made to fit in the current table (FM input can produce negative indices), then -interpolation returns the table value. Table-lookup scales its -frequency change argument (fm-input) to fit whatever its table size is -(that is, it assumes the caller is thinking in terms of a table size of two pi, -and fixes it up). The wave table should be an array of double-floats (the function -make-double-array can be used to create it). -type sets the type of interpolation used: mus-interp-none, -mus-interp-linear, mus-interp-lagrange, mus-interp-bezier, or mus-interp-hermite. -

- - - - - - - - - -
table-lookup methods
mus-frequency frequency in Hz
mus-phase phase in radians (wave-size/(2*pi))
mus-data wave array
mus-length wave size (no setf)
mus-interp-typeinterpolation choice (no setf)
mus-increment table increment per sample
- -

Table-lookup might be defined: -

-
-(prog1
-  (array-interp wave phase)
-  (incf phase (+ (hz->radians frequency) 
-                 (* fm-input 
-                    (/ (length wave) 
-                       (* 2 pi))))))
-
- -

There are two functions that make it easier to load up -various wave forms: -

- -
-partials->wave synth-data table &optional (norm t)
-phase-partials->wave synth-data table &optional (norm t)
-
- -

The synth-data argument is a list of (partial amp) pairs: '(1 .5 2 .25) -gives a combination of a sine wave at the carrier (1) at amplitude .5, and -another at the first harmonic (2) at amplitude .25. The partial amplitudes are -normalized to sum to a total amplitude of 1.0 unless the argument norm -is nil. If the initial phases matter (they almost never do), you can use -phase-partials->wave; in this case the synth-data is a list of (partial amp phase) triples with phases in radians.

- -
-(definstrument simple-table (dur)
-  (let ((tab (make-table-lookup :wave (partials->wave '(1 .5 2 .5)))))
-    (run
-     (loop for i from 0 to dur do
-       (outa i (* .3 (table-lookup tab)))))))
-
- -

spectr.clm has a steady state spectra of -several standard orchestral instruments, courtesy of James A. Moorer. -bird.clm (using bird.ins and bigbird.ins) has about 50 North American bird songs.

- - - - - -
polywave
- -
-make-polywave &optional-key (frequency 0.0) 
-        (partials '(1 1)) (type mus-chebyshev-first-kind)
-polywave w &optional (fm 0.0)
-polywave? w
-
-make-polyshape &optional-key (frequency 0.0) 
-        (initial-phase 0.0) coeffs (partials '(1 1)) (kind mus-chebyshev-first-kind)
-polyshape w &optional (index 1.0) (fm 0.0)
-polyshape? w
-
-partials->polynomial partials &optional (kind mus-chebyshev-first-kind)
-
- -

polywave is the new form of polyshape. -These two generators -drive a sum of scaled Chebyshev polynomials with -a sinusoid, creating a sort of cross between additive synthesis and FM; see -"Digital Waveshaping Synthesis" by Marc Le Brun in JAES 1979 April, vol 27, no 4, p250. -kind or type can be mus-chebyshev-first-kind or mus-chebyshev-second-kind. -

- - - - - - - - - -
polywave methods
mus-frequency frequency in Hz
mus-scaler index (polywave only)
mus-phase phase in radians
mus-data polynomial coeffs
mus-length number of partials
mus-increment frequency in radians per sample
- -

Polywave and polyshape:

-
-(prog1
-  (array-interp wave (* (length wave) 
-                        (+ 0.5 (* index 0.5 (sin phase)))))
-  (incf phase (+ (hz->radians frequency) fm)))
-
-(prog1
-  (polynomial wave (sin phase))
-  (incf phase (+ (hz->radians frequency) fm)))
-
- -

In its simplest use, waveshaping is an inexpensive additive synthesis: -

- -
-(definstrument simp ()
-  (let ((wav (make-polyshape :frequency 440 :partials '(1 .5 2 .3 3 .2))))
-    (run (loop for i from 0 to 1000 do (outa i (polyshape wav))))))
-
- -

-Bigbird is another example: -

- -
-(definstrument bigbird (start duration frequency freqskew amplitude freq-env amp-env partials)
-  (multiple-value-bind (beg end) (times->samples start duration)
-    (let* ((gls-env (make-env freq-env (hz->radians freqskew) duration))
-           (polyos (make-polyshape frequency
-                     :coeffs (partials->polynomial (normalize-partials partials))))
-           (fil (make-one-pole .1 .9))
-           (amp-env (make-env amp-env amplitude duration)))
-      (run
-        (loop for i from beg below end do
-          (outa i 
-            (one-pole fil   ; for distance effects
-              (* (env amp-env) 
-                 (polyshape polyos 1.0 (env gls-env))))))))))
-
-(with-sound ()
-  (bigbird beg .05 1800 1800 .2
-           '(.00 .00 .40 1.00 .60 1.00 1.00 .0)         ; freq env
-           '(.00 .00 .25 1.00 .60 .70 .75 1.00 1.00 .0) ; amp env
-           '(1 .5 2 1 3 .5 4 .1 5 .01)))                ; partials (bird song spectrum)
-
- -

-See also pqw.ins for phase quadrature waveshaping (single-sideband tricks). -

- - - - - -
sawtooth-wave and friends
- -
-make-triangle-wave &optional-key (frequency 0.0) (amplitude 1.0) (initial-phase pi)
-triangle-wave s &optional (fm 0.0)
-triangle-wave? s
-
-make-square-wave &optional-key (frequency 0.0) (amplitude 1.0) (initial-phase 0)
-square-wave s &optional (fm  0.0)
-square-wave? s
-
-make-sawtooth-wave &optional-key (frequency 0.0) (amplitude 1.0) (initial-phase pi)
-sawtooth-wave s &optional (fm 0.0)
-sawtooth-wave? s
-
-make-pulse-train &optional-key (frequency 0.0) (amplitude 1.0) (initial-phase two-pi)
-pulse-train s &optional (fm 0.0)
-pulse-train? s
-
- - -

These generators produce some standard old-timey wave forms that are still occasionally useful (well, triangle-wave -is useful; the others are silly). -sawtooth-wave ramps from -1 to 1, then goes immediately back to -1. -Use a negative frequency to turn the "teeth" the other way. -triangle-wave ramps from -1 to 1, then ramps from 1 to -1. -pulse-train produces a single sample of 1.0, then zeros. -square-wave produces 1 for half a period, then 0. All have a period -of two-pi, so the fm argument should have an effect comparable to the -same FM applied to the same waveform in table-lookup. -These are not band-limited; if the frequency is too high, you can get foldover, -but as far as I -know, no-one uses these as audio frequency tone generators — who would want to -listen to a square wave? A more reasonable square-wave can be generated via -tanh(n * sin(theta)), where "n" (a float) sets how squared-off it is. -Even more amusing is this algorithm: -

- -
-(defun cossq (c theta)    ; as c -> 1.0+, more of a square wave (try 1.00001)
-  (let* ((cs (cos theta)) ; (+ theta pi) if matching sin case (or (- ...))
-	 (cp1 (+ c 1.0))
-	 (cm1 (- c 1.0))
-	 (cm1c (expt cm1 cs))
-	 (cp1c (expt cp1 cs)))
-    (/ (- cp1c cm1c)
-       (+ cp1c cm1c))))  ; from "From Squares to Circles..." Lasters and Sharpe, Math Spectrum 38:2
-
-(defun sinsq (c theta) (cossq c (- theta (* 0.5 pi))))
-(defun sqsq (c theta) (sinsq c (- (sinsq c theta)))) ; a sharper square wave
-
-(let ((angle 0.0))
-  (loop ...
-    (let ((val (* 0.5 (+ 1.0 (sqsq 1.001 angle))))) 
-      (set! angle (+ angle .02)) 
-    ...)))
-
- - - - - - - - -
saw-tooth and friends' methods
mus-frequency frequency in Hz
mus-phase phase in radians
mus-scaler amplitude arg used in make-<gen>
mus-width width of square-wave pulse (0.0 to 1.0)
mus-increment frequency in radians per sample
- -
-One popular kind of vibrato is:
-  (+ (triangle-wave pervib) 
-     (rand-interp ranvib))
-
- -

Just for completeness, here's an example: -

- -
-(definstrument simple-saw (beg dur amp)
-  (let* ((os (make-sawtooth-wave 440.0))
-	 (start (floor (* beg *srate*)))
-	 (end (+ start (floor (* dur *srate*)))))
-    (run
-     (loop for i from start to end do
-       (outa i (* amp (sawtooth-wave os)))))))
-
- - - - - -
ncos and nsin
- -
-make-ncos &optional-key (frequency 0.0) (n 1)
-ncos cs &optional (fm 0.0)
-ncos? cs
-
-make-nsin &optional-key (frequency 0.0) (n 1)
-nsin cs &optional (fm 0.0)
-nsin? cs
-
- -

-ncos produces a band-limited pulse train containing -n cosines. I think this was originally viewed as a way to get a speech-oriented -pulse train that would then be passed through formant filters (see pulse-voice in examp.scm). There are many similar formulas: -see ncos2 and friends in generators.scm. "Trigonometric Delights" by Eli Maor has -a derivation of a nsin formula and a neat -geometric explanation. For a derivation of the ncos formula, see "Fourier -Analysis" by Stein and Shakarchi, or multiply the left side (the cosines) by sin(x/2), use the trig -formula 2sin(a)cos(b) = sin(b+a)-sin(b-a), and notice that all the terms in the series -cancel except the last. -

- - - - - - - - -
ncos methods
mus-frequency frequency in Hz
mus-phase phase in radians
mus-scaler (/ 1.0 cosines)
mus-length n or cosines arg used in make-<gen>
mus-increment frequency in radians per sample
- -
-ncos is based on:
-  cos(x) + cos(2x) + ... cos(nx) = 
-    (sin((n + .5)x) / (2 * sin(x / 2))) - 1/2
-
-  known as the Dirichlet kernel
-
- -
-(definstrument simple-soc (beg dur freq amp)
-  (let* ((os (make-ncos freq 10))
-	 (start (floor (* beg *srate*)))
-	 (end (+ start (floor (* dur *srate*)))))
-    (run
-     (loop for i from start to end do
-       (outa i (* amp (ncos os)))))))
-
- -

If you sweep ncos upwards in frequency, you'll eventually -get foldover; the generator produces its preset number of cosines no -matter what. It is possible to vary the spectrum smoothly (without stooping a filter): multiply the -output of ncos by an exponential — there's an example in sndclm.html. -

- -

nsin produces a sum of n equal amplitude sines. It is very similar (good and bad) to ncos. -

- - - - - - - - -
nsin methods
mus-frequency frequency in Hz
mus-phase phase in radians
mus-scaler dependent on number of sines
mus-length n or sines arg used in make-<gen>
mus-increment frequency in radians per sample
- -
-nsin is based on:
-  sin(x) + sin(2x) + ... sin(nx) = 
-    sin(n * x / 2) * (sin((n + .5)x) / sin(x / 2))
-
-  known as the conjugate Dirichlet kernel
-
- - - - - - -
ssb-am
- -
-make-ssb-am &optional-key (frequency 0.0) (order 40)
-ssb-am gen &optional (insig 0.0) (fm 0.0)
-ssb-am? gen
-
- -

ssb-am provides single sideband suppressed carrier amplitude modulation, normally used for frequency shifting. -

- - - - - - - - - - - - -
ssb-am methods
mus-frequency frequency in Hz
mus-phase phase (of embedded sin osc) in radians
mus-order embedded delay line size
mus-length same as mus-order
mus-interp-type mus-interp-none
mus-xcoeff FIR filter coeff
mus-xcoeffs embedded Hilbert transform FIR filter coeffs
mus-data embedded filter state
mus-increment frequency in radians per sample
- -
-ssb-am is based on:
-  cos(freq) * delay(insig) +/- sin(freq) * hilbert(insig) 
-  which shifts insig spectrum by freq 
-  and cancels upper/lower sidebands
-
- -

See the instrument under amplitude-modulate for -an explicit version of this generator. -Here's a complicated way to get a sine wave at 550 Hz: -

- -
-(definstrument shift-pitch (beg dur freq amp shift)
-  (let* ((os (make-oscil freq))
-	 (start (floor (* beg *srate*)))
-	 (end (+ start (floor (* dur *srate*))))
-	 (am (make-ssb-am shift)))
-    (run
-     (loop for i from start to end do
-       (outa i (* amp (ssb-am am (oscil os))))))))
-
- - - - - - -
wave-train
- -
-make-wave-train &optional-key (frequency 0.0) (initial-phase 0.0) wave size type
-wave-train w &optional (fm 0.0)
-wave-train? w
-
- -

wave-train produces a wave train (an extension of pulse-train and table-lookup). -Frequency is the repetition rate of the wave found in wave. -Successive waves can overlap. With some simple envelopes, or filters, you can -use this for VOSIM and other related techniques.

- - - - - - - - -
wave-train methods
mus-frequency frequency in Hz
mus-phase phase in radians
mus-data wave array (no setf)
mus-length length of wave array (no setf)
mus-interp-typeinterpolation choice (no setf)
- -

Here is a FOF instrument based loosely on fof.c of Perry Cook and the article -"Synthesis of the Singing Voice" by Bennett and Rodet in -"Current Directions in Computer Music Research". -

- -
-(definstrument fofins (beg dur frq amp vib f0 a0 f1 a1 f2 a2 &optional ve ae)
-  (let* ((start (floor (* beg *srate*)))
-         (end (+ start (floor (* dur *srate*))))
-         (ampf (make-env (or ae (list 0 0 25 1 75 1 100 0)) :scaler amp :duration dur))
-         (frq0 (hz->radians f0))
-         (frq1 (hz->radians f1))
-         (frq2 (hz->radians f2))
-         (foflen (if (= *srate* 22050) 100 200))
-         (vibr (make-oscil 6))
-	 (vibenv (make-env (or ve (list 0 1 100 1)) :scaler vib :duration dur))
-         (win-freq (/ two-pi foflen))
-         (foftab (make-double-float-array foflen))
-         (wt0 (make-wave-train :wave foftab :frequency frq)))
-    (loop for i from 0 below foflen do
-      (setf (aref foftab i) (double-float      
-        ;; this is not the pulse shape used by B&R
-            (* (+ (* a0 (sin (* i frq0))) 
-                  (* a1 (sin (* i frq1))) 
-                  (* a2 (sin (* i frq2)))) 
-               .5 (- 1.0 (cos (* i win-freq)))))))
-    (run
-     (loop for i from start below end do
-       (outa i (* (env ampf) (wave-train wt0 (* (env vibenv) (oscil vibr)))))))))
-
-(with-sound () (fofins 0 1 270 .2 .001 730 .6 1090 .3 2440 .1)) ; "Ahh"
-
-(with-sound () 
-  (fofins 0 4 270 .2 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1) 
-          '(0 0 .5 1 3 .5 10 .2 20 .1 50 .1 60 .2 85 1 100 0))
-  (fofins 0 4 (* 6/5 540) .2 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1) 
-          '(0 0 .5 .5 3 .25 6 .1 10 .1 50 .1 60 .2 85 1 100 0))
-  (fofins 0 4 135 .2 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1) 
-          '(0 0 1 3 3 1 6 .2 10 .1 50 .1 60 .2 85 1 100 0)))
-
- - - - - - -
rand
- -
-make-rand &optional-key 
-        (frequency 0.0)          ; freq at which new random numbers occur
-        (amplitude 1.0)            ; numbers are between -amplitude and amplitude
-        (envelope '(-1 1 1 1))     ; distribution envelope (uniform distribution between -1 and 1 is the default)
-        distribution               ; pre-computed distribution
-rand r &optional (sweep 0.0)
-rand? r
-
-make-rand-interp &optional-key 
-        (frequency 0.0) 
-        (amplitude 1.0) 
-        (envelope '(-1 1 1 1) 
-        distribution)
-rand-interp r &optional (sweep 0.0)
-rand-interp? r
-
-centered-random amp 
-clm-random amp
-mus-random amp ; same as centered-random (for C-side compatibility)
-mus-set-rand-seed seed
-
- - -

rand returns a sequence of random numbers between -amplitude and -amplitude (it produces a sort of step function). -rand-interp interpolates between successive -random numbers; -it could be defined as (moving-average agen (rand rgen)) where the -averager has the same period (length) as the rand. -Lisp's function random returns a number between 0.0 and its argument. -In both cases, the envelope argument determines the random number distribution. -centered-random returns a number between -amp and amp. -clm-random returns a random number between 0 and amp. In the latter two cases, -mus-set-rand-seed sets the seed for the random number generator. This provides a -way around Lisp's clumsy mechanism for repeating a random number sequence. -

- - - - - - - - - -
rand and rand-interp methods
mus-frequency frequency in Hz
mus-phase phase in radians
mus-scaler amplitude arg used in make-<gen>
mus-length distribution table length
mus-data distribution table, if any
mus-increment frequency in radians per sample
- -
-rand:
-  (if (>= phase (* 2 pi))
-      (setf output (centered-random amplitude)))
-  (incf phase (+ (hz->radians frequency) sweep))
-
- -

There are a variety of ways to change rand's uniform distribution to -some other: (random (random 1.0)) or (sin (random 3.14159)) are simple examples. Exponential distribution could be: -

- -
-  (/ (log (max .01 (random 1.0))) (log .01))
-
- -

where the ".01"'s affect how tightly the resultant values cluster toward 0.0 — -set it to .0001 for example to get most of the random values close to 0.0. -The central-limit theorem says that you can get closer and closer to gaussian -noise by adding rand's together. Orfanidis in -"Introduction to Signal Processing" says 12 calls on rand will -do perfectly well. -We could define our own generator: -

- -
-(defmacro gaussian-noise (r)
-  ;; r=a rand generator allocated via make-rand
-  `(let ((val 0.0))
-     (dotimes (i 12) (incf val (rand ,r)))
-     val))
-
- -

-For a discussion of the central limit theorem, see -Korner "Fourier Analysis" and Miller Puckette's dissertation: -http://www-crca.ucsd.edu/~msp/Publications/thesis.ps. -Another method is the "rejection method" in which we generate random number -pairs until we get a pair that falls within the -desired distribution; see random-any in dsp.scm (Snd) for code to do this. -It is faster at run time, however, to use the "transformation method". -The make-rand and make-rand-interp envelope arguments specify -the desired distribution function; the generator takes the -inverse of the integral of the envelope, loads that into an array, and uses -(array-interp (rand array-size)) at run time. This gives -random numbers of any arbitrary distribution at a computational cost -equivalent to the polyshape generator (which is very similar). -The x axis sets the output range (before scaling by amplitude), and -the y axis sets the relative weight of the corresponding x axis value. -So, the default is '(-1 1 1 1) which says "output numbers between -1 and 1, -each number having the same chance of being chosen". -An envelope of '(0 1 1 0) outputs values between 0 and 1, denser toward 0. -If you already have the distribution table (the result of (inverse-integrate envelope)), -you can pass it through the distribution argument. -

- -

-You can, of course, filter the output of rand to get a different -frequency distribution (as opposed to the "value distribution" -above, all of which are forms of white noise). -Orfanidis also mentions a clever way to get reasonably good 1/f noise: -sum together n rand's, where each rand is running an octave slower -than the preceding: -

- -
-(defun make-1f-noise (n)
-  ;; returns an array of rand's ready for the 1f-noise generator
-  (let ((rans (make-array n)))
-    (dotimes (i n) (setf (aref rans i) (make-rand :frequency (/ *srate* (expt 2 i)))))
-    rans))
-
-(defmacro 1f-noise (rans)
-  `(let ((val 0.0)
-         (len (length ,rans)))
-     (dotimes (i len) (incf val (rand (aref ,rans i))))
-     (/ val len)))
-
- -

See also green.cl (bounded brownian noise that can mimic 1/f noise in some cases). -And we can't talk about noise without mentioning fractals:

- -
-(definstrument fractal (start duration m x amp)
-  ;; use formula of M J Feigenbaum
-  (let* ((beg (floor (* *srate* start)))
-	 (end (+ beg (floor (* *srate* duration)))))
-    (run
-     (loop for i from beg below end do
-       (outa i (* amp x))
-       (setf x (- 1.0 (* m x x)))))))
-
-;;; quickly reaches a stable point for any m in[0,.75], so:
-(with-sound () (fractal 0 1 .5 0 .5)) 
-;;; is just a short "ftt"
-(with-sound () (fractal 0 1 1.5 .20 .2))
-
- -

With this instrument you can easily hear -the change over from the stable equilibria, to the period doublings, -and finally into the combination of noise and periodicity that -has made these curves famous. See appendix 2 to Ekeland's "Mathematics and the Unexpected" for more details. -Another instrument based on similar ideas is:

- -
-(definstrument attract (beg dur amp c) ; c from 1 to 10 or so
-  ;; by James McCartney, from CMJ vol 21 no 3 p 6
-  (let* ((st (floor (* beg *srate*)))
-	 (nd (+ st (floor (* dur *srate*))))
-	 (a .2) (b .2) (dt .04)
-	 (scale (/ (* .5 amp) c))
-	 (x1 0.0) (x -1.0) (y 0.0) (z 0.0))
-    (run
-     (loop for i from st below nd do
-       (setf x1 (- x (* dt (+ y z))))
-       (incf y (* dt (+ x (* a y))))
-       (incf z (* dt (- (+ b (* x z)) (* c z))))
-       (setf x x1)
-       (outa i (* scale x))))))
-
- -

which gives brass-like sounds! -

- - - - - - -
one-pole and friends
- - -
- make-one-pole &optional-key a0 b1    ; b1 < 0.0 gives lowpass, b1 > 0.0 gives highpass
- one-pole f input 
- one-pole? f
-
- make-one-zero &optional-key a0 a1    ; a1 > 0.0 gives weak lowpass, a1 < 0.0 highpass
- one-zero f input 
- one-zero? f
-
- make-two-pole &optional-key a0 b1 b2 frequency radius
- two-pole f input 
- two-pole? f
-
- make-two-zero &optional-key a0 a1 a2 frequency radius
- two-zero f input 
- two-zero? f
-
- - - - - - - - -
simple filter methods
mus-xcoeff a0, a1, a2 in equations
mus-ycoeff b1, b2 in equations
mus-order 1 or 2 (no setf)
mus-scaler two-pole and two-zero radius
mus-frequency two-pole and two-zero center frequency
- -
-one-zero  y(n) = a0 x(n) + a1 x(n-1)
-one-pole  y(n) = a0 x(n) - b1 y(n-1)
-two-pole  y(n) = a0 x(n) - b1 y(n-1) - b2 y(n-2)
-two-zero  y(n) = a0 x(n) + a1 x(n-1) + a2 x(n-2)
-
- -

-The "a0, b1" nomenclature is taken from Julius Smith's "An Introduction to Digital -Filter Theory" in Strawn "Digital Audio Signal Processing", and is different -from that used in the more general filters such as fir-filter. -In make-two-pole and make-two-zero you can specify either the actual -desired coefficients (a0 and friends), or the center frequency and radius of the -filter (frequency and radius). -radius should be between 0 and 1 (but less than 1), and -frequency should be between 0 and srate/2. -

-

The bird instrument uses a one-pole filter for a distance cue: -

- -
-(definstrument bird (startime dur frequency freq-skew amplitude freq-envelope amp-envelope 
-	             &optional (lpfilt 1.0) (degree 0) (reverb-amount 0))
-  (multiple-value-bind (beg end) (times->samples startime dur)
-    (let* ((amp-env (make-env amp-envelope amplitude dur))
-	   (gls-env (make-env freq-envelope (hz->radians freq-skew) dur))
-	   (loc (make-locsig :degree degree :distance 1.0 :reverb reverb-amount))
-	   (fil (make-one-pole lpfilt (- 1.0 lpfilt)))
-	   (s (make-oscil :frequency frequency)))
-      (run
-       (loop for i from beg to end do
-	 (locsig loc i (one-pole fil (* (env amp-env) 
-                                        (oscil s (env gls-env))))))))))
-
- - - - - - -
formant
- -
-make-formant &optional-key frequency radius
-formant f input       ; resonator centered at frequency, bandwidth set by radius above
-formant? f
-
-make-firmant &optional-key frequency radius
-firmant f input       ; resonator centered at frequency, bandwidth set by radius above
-firmant? f
-
- - - - - - -
formant methods
mus-frequency formant center frequency
mus-order 2 (no setf)
mus-scaler gain
- -
-formant:
-    y(n) = x(n) - 
-           r * x(n-2) + 
-           2 * r * cos(frq) * y(n-1) - 
-           r * r * y(n-2)
-
-    firmant:
-    x(n+1) = r * (x(n) - 2 * sin(frq/2) * y(n)) + input
-    y(n+1) = r * (2 * sin(frq/2) * x(n+1) + y(n))
-
- -

formant and firmant are resonators (two-pole, two-zero bandpass filters) centered at "frequency", with the bandwidth set by "radius". -The formant generator is described in "A Constant-gain Digital Resonator Tuned By a Single Coefficient" by Julius -O. Smith and James B. Angell in Computer Music Journal Vol. 6 No. 4 (winter -1982) and "A note on -Constant-Gain Digital Resonators" by Ken Steiglitz, CMJ vol 18 No. 4 pp.8-10 -(winter 1994). -The formant bandwidth is a function of the "radius", and its center frequency is set by "frequency". -As the radius approaches 1.0 (the unit circle), the -resonance gets narrower. -Use mus-frequency to change the center frequency, and mus-scaler to change the radius. -The radius can be set in terms of desired bandwidth in Hz via: -

- -
-(exp (* -0.5 (hz->radians bandwidth)))
-
- -

If you change the radius, the peak amplitude -of the output changes. -The firmant generator is the "modified coupled form" of the formant generator, -developed by Max Mathews and Julius Smith in "Methods for Synthesizing Very High Q Parametrically -Well Behaved Two Pole Filters". -grapheq.ins uses a bank of formant generators to implement a graphic equalizer, -and fade.ins uses it for frequency domain mixing. Here is an instrument -for cross-synthesis with a bank of 128 formants: -

- - -
-(definstrument cross-synthesis (beg dur file1 file2 amp &optional (fftsize 128) (r two-pi) (lo 2) (hi nil))
-  ;; file1: input sound, file2: gives spectral shape
-  ;; r: controls width of formants (1.0 is another good value here)
-  ;; lo and hi: which of the formants are active (a sort of filter on top of the filter)
-  ;; we use the on-going spectrum of file2 to scale the outputs of the formant array
-  (let* ((fil1 (open-input* file1))
-	 (fil2 (and fil1 (open-input* file2))))
-    (when fil1
-      (if (not fil2)
-          (close-input fil1)
-        (unwind-protect
-	  (let* ((start (floor (* beg *srate*)))
-	         (end (+ start (floor (* dur *srate*))))
-	         (freq-inc (floor fftsize 2))
-	         (fdr (make-double-float-array fftsize))
-	         (fdi (make-double-float-array fftsize))
-	         (diffs (make-double-float-array freq-inc))
-	         (spectrum (make-double-float-array freq-inc))
-	         (filptr 0)
-	         (ctr freq-inc)
-	         (radius (- 1.0 (/ r fftsize)))
-	         (bin (float (/ *srate* fftsize)))
-	         (fs (make-array freq-inc)))
-	    (if (null hi) (setf hi freq-inc))
-	    (loop for k from lo below hi do 
-              (setf (aref fs k) (make-formant (* k bin) radius)))
-	    (run
-	     (loop for i from start below end do
-	       (when (= ctr freq-inc)
-	         (dotimes (k fftsize)
-		   (setf (aref fdr k) (ina filptr fil2))
-		   (incf filptr))
-	         (clear-array fdi)
-	         (decf filptr freq-inc)
-	         (fft fdr fdi fftsize 1)
-	         (rectangular->magnitudes fdr fdi)
-	         (dotimes (k freq-inc) 
-                   (setf (aref diffs k) 
-                     (/ (- (aref fdr k) (aref spectrum k)) freq-inc)))
-	         (setf ctr 0))
-	       (incf ctr)
-	       (dotimes (k freq-inc) 
-                 (incf (aref spectrum k) (aref diffs k)))
-	       (let ((outval 0.0)
-		     (inval (ina i fil1)))
-	         (loop for k from lo below hi do 
-                   (incf outval (* (aref spectrum k) (formant (aref fs k) inval))))
-	         (outa i (* amp outval))))))
-        (progn
-	  (close-input fil1)
-	  (close-input fil2)))))))
-
-(with-sound () (cross-synthesis 0 1 "oboe" "fyow" .5 256 1.0 3 100))
-
- - - - - -
filter, iir-filter, fir-filter
- -
- make-filter &optional-key order xcoeffs ycoeffs
- filter fl inp 
- filter? fl
-
- make-fir-filter &optional-key order xcoeffs
- fir-filter fl inp 
- fir-filter? fl
-
- make-iir-filter &optional-key order ycoeffs
- iir-filter fl inp 
- iir-filter? fl
-
- envelope->coeffs &key order envelope dc
-
- -

These are the general FIR/IIR filters of arbitrary order. -The order argument is one greater than the nominal filter -order (it is the size of the arrays). -

- - - - - - - - - - -
general filter methods
mus-order filter order
mus-xcoeff x (input) coeff
mus-xcoeffs x (input) coeffs
mus-ycoeff y (output) coeff
mus-ycoeffs y (output) coeffs
mus-data current state (input values)
mus-length same as mus-order
- -
-filter:
-  (let ((xout 0.0))
-    (setf (aref state 0) input)
-    (loop for j from order downto 1 do
-      (incf xout (* (aref state j) (aref xcoeffs j)))
-      (decf (aref state 0) (* (aref ycoeffs j) (aref state j)))
-      (setf (aref state j) (aref state (1- j))))
-    (+ xout (* (aref state 0) (aref xcoeffs 0))))
-
- -

dsp.scm in the Snd package has a number of filter design functions, -and various specializations of the filter generators, including such -perennial favorites as biquad, butterworth, hilbert transform, and -notch filters. Similarly, analog-filter.scm in the Snd tarball has -the usual IIR suspects: Butterworth, Chebyshev, Bessel, and Elliptic filters. -

- -

Say we want to put a spectral envelope on a noise source. -

- -
-(definstrument filter-noise (beg dur amp &key xcoeffs)
-  (let* ((st (floor (* beg *srate*)))
-         (noi (make-rand :frequency (* .5 *srate*) :amplitude amp))
-         (flA (make-filter :xcoeffs xcoeffs))
-         (nd (+ st (floor (* *srate* dur)))))
-    (run
-      (loop for i from st below nd do
-        (outa i (filter flA (rand noi)))))))
-
-(with-sound () 
-  (filter-noise 0 1 .2 
-    :xcoeffs (envelope->coeffs :order 12 :envelope '(0 0.0 .125 0.5 .2 0.0 .3 1.0 .5 0.0 1.0 0.0))))
-
- -

envelope->coeffs translates a frequency response envelope into the corresponding FIR filter coefficients. -The order of the filter determines how close you -get to the envelope.

- -

The Hilbert transform can be implemented with an fir-filter:

- -
-(defun make-hilbert (&optional (len 30))
-  ;; create the coefficients of the Hilbert transformer of length len
-  (let* ((arrlen (1+ (* 2 len)))
-	 (arr (make-array arrlen)))
-    (do ((i (- len) (1+ i)))
-	((= i len))
-      (let* ((k (+ i len))
-	     (denom (* pi i))
-	     (num (- 1.0 (cos (* pi i)))))
-	(if (= i 0)
-	    (setf (aref arr k) 0.0)
-	    (setf (aref arr k) (/ num denom)))))
-    (make-fir-filter arrlen (loop for i from 0 below arrlen collect (aref arr i)))))
-
-(defmacro hilbert (f in) `(fir-filter ,f ,in))
-
- - - - - -
delay
- -
-make-delay &optional-key size initial-contents initial-element max-size type
-delay d input &optional (pm 0.0)
-delay? d
-tap d &optional (offset 0)
-delay-tick d input
-
- -

delay is a delay line. size is in samples. -Input fed into a delay line reappears at the output size samples -later. initial-element defaults to 0.0. -tap returns the -current value of the delay generator. Its offset is the distance of the tap -from the current delay line sample. If max-size is specified, -and larger than size, the delay line can provide fractional delays. -It should be large enough to accommodate the largest actual -delay requested at run-time. -pm determines how far from the normal index we are; that is, -it is difference between the nominal -delay length (size) and the current actual delay length (size -+ pm). A positive pm corresponds to a longer -delay line. The type argument sets the interpolation type: -mus-interp-none, mus-interp-linear, mus-interp-all-pass, -mus-interp-lagrange, mus-interp-bezier, or mus-interp-hermite. -delay-tick just puts a sample in the delay line. 'ticks' the delay forward, and -returns its input argument. This is aimed at physical modeling instruments -where a tap is doing the actual delay line read. -

- - - - - - - - -
delay methods
mus-length length of delay
mus-order same as mus-length
mus-data delay line itself (no setf)
mus-interp-type interpolation choice (no setf)
mus-scaler unused internally, but available for delay specializations
- -
-delay:
-(prog1
-  (array-interp line (- loc pm))
-  (setf (aref line loc) input)
-  (incf loc)
-  (if (<= size loc) (setf loc 0)))
-
- -
-(definstrument echo (beg dur scaler secs file)
-  (let ((del (make-delay (round (* secs *srate*))))
-	(inf (open-input file))
-	(j 0))
-    (run
-     (loop for i from beg below (+ beg dur) do
-       (let ((inval (ina j inf)))
-	 (outa i (+ inval (delay del (* scaler (+ (tap del) inval)))))
-	 (incf j))))
-    (close-input inf)))
-
-;;; (with-sound () (echo 0 60000 .5 1.0 "pistol.snd"))
-
- - - - - - -
comb and notch
- -
-make-comb &optional-key scaler size initial-contents initial-element max-size
-comb cflt input &optional (pm 0.0)
-comb? cflt
-
-make-filtered-comb &optional-key scaler size initial-contents initial-element max-size filter
-filtered-comb cflt input &optional (pm 0.0)
-filtered-comb? cflt
-
-make-notch &optional-key scaler size initial-contents initial-element max-size
-notch cflt input &optional (pm 0.0)
-notch? cflt
-
- -

comb is a delay line with a scaler on the feedback term. notch -is a delay line with a scaler on the feedforward term. -size is the length -in samples of the delay line. -Other arguments are handled as in delay. -filtered-comb is a comb filter with a one-zero filter on the feedback. -

- - - - - - - - - -
comb, filtered-comb, and notch methods
mus-length length of delay
mus-order same as mus-length
mus-data delay line itself (no setf)
mus-feedback scaler (comb only)
mus-feedforward scaler (notch only)
mus-interp-type interpolation choice (no setf)
- -
- comb:           y(n) = x(n - size) + scaler * y(n - size)
- notch:          y(n) = x(n) * scaler  + x(n - size)
- filtered-comb:  y(n) = x(n - size) + scaler * filter(y(n - size))
-
- -

As a rule of thumb, the decay time of the feedback part is -7.0 * size / (1.0 - scaler) samples, so to get a decay of dur seconds, -scaler <= 1.0 - 7.0 * size / (dur * *srate*). The peak gain is 1.0 / (1.0 - (abs -scaler)). The peaks (or valleys in notch's case) are evenly spaced -at *srate* / size. The height (or depth) thereof is determined by scaler — -the closer to 1.0, the more pronounced. -See Julius Smith's "An Introduction to Digital Filter Theory" in -Strawn "Digital Audio Signal Processing", or Smith's "Music Applications of -Digital Waveguides". -The following instrument sweeps the comb filter using the pm argument: -

- -
-(definstrument zc (time dur freq amp length1 length2 feedback)
-  (multiple-value-bind
-      (beg end) (times->samples time dur)
-    (let ((s (make-pulse-train :frequency freq))  ; some raspy input so we can hear the effect easily
-          (d0 (make-comb :size length1 :max-size (max length1 length2) :scaler feedback))
-          (zenv (make-env '(0 0 1 1) :scaler (- length2 length1) :duration dur)))
-      (run
-       (loop for i from beg to end do
-	 (outa i (comb d0 (* amp (pulse-train s)) (env zenv))))))))
-
-(with-sound () (zc 0 3 100 .1 20 100 .5) (zc 3.5 3 100 .1 90 100 .95))
-
- - - - - - -
all-pass
- -
-make-all-pass &optional-key feedback feedforward size initial-contents initial-element max-size
-all-pass f input &optional (pm 0.0)
-all-pass? f
-
- -

all-pass or moving average comb is just like comb but with -an added feedforward term. If feedforward = 0, we get a -comb filter. If both scale terms = 0, we get a pure delay line.

- - - - - - - - - -
all-pass methods
mus-length length of delay
mus-order same as mus-length
mus-data delay line itself (no setf)
mus-feedback feedback scaler
mus-feedforward feedforward scaler
mus-interp-type interpolation choice (no setf)
- -
- y(n) = feedforward * x(n) + x(n - size) + feedback * y(n - size)
-
- -

all-pass filters are used extensively in reverberation; see jcrev.ins or nrev.ins for examples. -

- - - - - -
moving-average
- -
-make-moving-average &optional-key size initial-contents initial-element
-moving-average f input
-moving-average? f
-
- -

moving-average or moving window average returns the average of the last 'size' values input to it. -This is used both to track rms values and to generate ramps between 0 and 1 in a "gate" -effect in new-effects.scm and in rms-envelope in env.scm (Snd). It could also be viewed as a low-pass filter. -

- - - - - - -
moving-average methods
mus-length length of table
mus-order same as mus-length
mus-data table of last 'size' values
- -
-result = sum-of-last-n-inputs / n
-
- -

moving-average is used in Snd's dsp.scm to implement several related functions: -moving-rms, moving-sum, and moving-length. I might make these CLM generators someday. -

- - - - - -
src
- - -
-make-src &optional-key input (srate 1.0) (width 5)
-src s &optional (sr-change 0.0) input-function
-src? s
-
- - - - -
src methods
mus-incrementsrate arg to make-src
- -

src performs sampling rate conversion -by convolving its input with a sinc -function. -srate is the -ratio between the old sampling rate and the new; an srate of 2 causes the sound to be half as long, transposed up an octave. -width is how many neighboring samples to convolve with sinc. -If you hear high-frequency artifacts in the conversion, try increasing this number; -Perry Cook's default value is 40, and I've seen cases where it needs to be 100. -It can also be set as low as 2 in some cases. -The greater the width, the slower the src generator runs. -The sr-change -argument is the amount to add to the current srate on a sample by sample -basis (if it's 0.0 and the original make-src srate argument was also 0.0, you get a constant output because the generator is not moving at all). Here's -an instrument that provides time-varying sampling rate conversion: -

- -
-(definstrument simple-src (start-time duration amp srt srt-env filename)
-  (let* ((senv (make-env srt-env :duration duration))
-         (beg (floor (* start-time *srate*)))
-         (end (+ beg (floor (* duration *srate*))))
-         (src-gen (make-src :input filename :srate srt)))
-    (run
-      (loop for i from beg below end do
-        (outa i (* amp (src src-gen (env senv))))))))
-
- - - -

src can provide an all-purpose "Forbidden Planet" sound effect:

- -
-(definstrument srcer (start-time duration amp srt fmamp fmfreq filename)
-  (let* ((os (make-oscil :frequency fmfreq))
-         (beg (floor (* start-time *srate*)))
-         (end (+ beg (floor (* duration *srate*))))
-         (src-gen (make-src :input filename :srate srt)))
-    (run
-      (loop for i from beg below end do
-        (outa i (* amp (src src-gen (* fmamp (oscil os)))))))))
-
-(with-sound () (srcer 0 2 1.0   1 .3 20 "fyow.snd"))   
-(with-sound () (srcer 0 25 10.0   .01 1 10 "fyow.snd"))
-(with-sound () (srcer 0 2 1.0   .9 .05 60 "oboe.snd")) 
-(with-sound () (srcer 0 2 1.0   1.0 .5 124 "oboe.snd"))
-(with-sound () (srcer 0 10 10.0   .01 .2 8 "oboe.snd"))
-(with-sound () (srcer 0 2 1.0   1 3 20 "oboe.snd"))    
-
-(definstrument hello-dentist (beg dur file frq amp)
-  (let ((rd (make-src :input file))
-        (rn (make-rand-interp :frequency frq :amplitude amp))
-        (end (+ beg dur)))
-    (run
-      (loop for i from beg below end do
-        (outa i (src rd (rand-interp rn)))))))
-
- -

The input argument to make-src and the input-function argument -to src provide the generator with input as it is needed. -The input function -takes one argument (the desired read direction, if the reader can support it); it is funcall'd each time the src generator needs another -sample of input. The input argument to src can also be an input file structure, as returned by -open-input, or as here, just the filename itself. -The simple-src instrument above could be written to use an input function instead: -

- -
-(definstrument src-with-readin (start-time duration amp srt srt-env filename)
-  (let* ((senv (make-env srt-env :duration duration))
-         (beg (floor (* start-time *srate*)))
-	 (rd (make-readin filename))
-         (end (+ beg (floor (* duration *srate*))))
-         (src-gen (make-src :srate srt)))
-    (run
-      (loop for i from beg below end do
-        (outa i (* amp (src src-gen (env senv) #'(lambda (dir) (readin rd)))))))))
-
- -

-If you jump around in the input (via mus-location for example), you can use the -mus-reset function to clear out any lingering state before starting to read at -the new position. (src, like many other generators, has an internal buffer -of recently read samples, so a sudden jump to a new location will otherwise cause -a click). -

- - - - - - -
convolve
- -
-make-convolve &optional-key input filter fft-size filter-size
- convolve ff &optional input-function
- convolve? ff
- convolve-files file1 file2 &optional (maxamp 1.0) (output-file "tmp.snd")
-
- - - - -
convolve methods
mus-lengthfft size used in the convolution
- -

-convolve convolves its input with the impulse response filter. -The filter argument -can be -an array, the result of open-input, or a filename as a string. -When not file based, -input and input-function are functions of one argument (currently ignored) that are -funcall'd whenever convolve needs input. -

- -
-(definstrument convins (beg dur filter file &optional (size 128))
-  (let* ((start (floor (* beg *srate*)))
-         (end (+ start (floor (* dur *srate*))))
-         (ff (make-convolve :input file :fft-size size :filter filter)))
-    (run
-      (loop for i from start below end do 
-        (outa i (convolve ff))))))
-
- -

convolve-files handles a very common special case: you often want to convolve -two files, normalizing the result to some maxamp. The convolve generator does not -know in advance what its maxamp will be, and when the two files are more or less -the same size, there's no real computational savings to using overlap-add (i.e. -the generator), so a one-time giant FFT saved as a temporary sound file is much -handier.

- - - - - -
granulate
- - -
-make-granulate &optional-key   
-        input
-        (expansion 1.0)   ; how much to lengthen or compress the file
-        (length .15)      ; length of file slices that are overlapped
-        (scaler .6)       ; amplitude scaler on slices (to avoid overflows)
-        (hop .05)         ; speed at which slices are repeated in output
-        (ramp .4)         ; amount of slice-time spent ramping up/down
-        (jitter 1.0)      ; affects spacing of successive grains
-        max-size          ; internal buffer size
-        edit              ; grain editing function (Scheme/Ruby, not CL)
-granulate e &optional input-function edit-function
-granulate? e
-
- - - - - - - - - - - -
granulate methods
mus-frequency time (seconds) between output grains (hop)
mus-ramp length (samples) of grain envelope ramp segment
mus-hop time (samples) between output grains (hop)
mus-scaler grain amp (scaler)
mus-increment expansion
mus-length grain length (samples)
mus-data grain samples (a vct)
mus-location granulate's local random number seed
- -
-result = overlap add many tiny slices from input
-
- -

granulate "granulates" its input (normally a sound file). It is the poor man's way -to change the speed at which things happen in a recorded sound without -changing the pitches. It works by slicing the input file into short -pieces, then overlapping these slices to lengthen (or shorten) the -result; this process is sometimes known as granular synthesis, and is -similar to the freeze function. -

- -

The duration of each slice is -length — the longer the slice, the more like reverb the effect. The -portion of the length (on a scale from 0 to 1.0) spent on each -ramp (up or down) is ramp. This can control the smoothness of -the result of the overlaps. -

- -

-jitter sets -the accuracy with which we hop. If you set it to 0, you can get very strong -comb filter effects, or tremolo. -The more-or-less average time between -successive segments is hop. -If jitter is 0.0, and hop is very small (say .01), -you're asking for trouble (a big comb filter). -If you're granulating more than one channel at a time, and want the channels to remain -in-sync, make each granulator use the same initial random number seed (via mus-location). -

- -

The overall amplitude scaler on each segment is -scaler — this is used to try to avoid overflows as we add -all these zillions of segments together. expansion -determines the input hop in relation to the output hop; an -expansion-amount of 2.0 should more or less double the length of the -original, whereas an expansion-amount of 1.0 should return something -close to the original speed. -input and input-function are the same as in src and convolve. -

- -
-(definstrument granulate-sound (file beg &optional dur (orig-beg 0.0) (exp-amt 1.0))
-  (let* ((f-srate (sound-srate file))
-	 (f-start (round (* f-srate orig-beg)))
-         (f (open-input file :start f-start))
-	 (st (floor (* beg *srate*)))
-	 (new-dur (or dur (- (sound-duration file) orig-beg)))
-	 (exA (make-granulate :input f :expansion exp-amt))
-	 (nd (+ st (floor (* *srate* new-dur)))))
-    (run
-     (loop for i from st below nd do
-       (outa i (granulate exA))))
-    (close-input f)))
-
- -

See expsrc.ins. Here's an instrument that uses the input-function -argument to granulate. It cause the granulation to run backwards through the file: -

- -
-(definstrument grev (beg dur exp-amt file file-beg)
-  (let* ((exA (make-granulate :expansion exp-amt))
-	 (fil (open-input* file file-beg))
-	 (ctr file-beg))
-    (run
-     (loop for i from beg to (+ beg dur) do
-       (outa i (granulate exA
-			  #'(lambda (dir)
-			      (let ((inval (ina ctr fil)))
-				(if (> ctr 0) (setf ctr (1- ctr)))
-				inval))))))
-    (close-input fil)))
-
-(with-sound () (grev 0 100000 2.0 "pistol.snd" 40000))
-
- -

-The edit argument can -be a function of one argument, the current granulate generator. It is called just before -a grain is added into the output buffer. The current grain is accessible via mus-data. -The edit function, if any, should return the length in samples of the grain, or 0. -

- - - - - -
phase-vocoder
- -
-make-phase-vocoder &optional-key input (fft-size 512) (overlap 4) interp (pitch 1.0) analyze edit synthesize
-phase-vocoder pv input-function analyze-function edit-function synthesize-function
-phase-vocoder? pv
-
- - - - - - - - -
phase-vocoder methods
mus-frequency pitch shift
mus-length fft-size
mus-increment interp
mus-hop fft-size / overlap
mus-location outctr (counter to next fft)
- -

phase-vocoder provides a generator to perform phase-vocoder analysis and resynthesis. The process is -split into three pieces, the analysis stage, editing of the amplitudes and phases, then the resynthesis. -Each stage has a default that is invoked if the analyze, edit, or synthesize -arguments are omitted from make-phase-vocoder or the phase-vocoder generator. The edit and synthesize arguments are functions of one argument, the -phase-vocoder generator. The analyze argument is a function of two arguments, the generator and -the input function. The default is to read the current input, -take an fft, get the new amplitudes and phases (as the edit -function default), then resynthesize using sines; so, the -default case returns a resynthesis of the original input. interp sets the time between -ffts (for time stretching etc). -

- -
-(definstrument simple-pvoc (beg dur amp size file)
-  (let* ((start (floor (* beg *srate*)))
-	 (end (+ start (floor (* dur *srate*))))
-	 (sr (make-phase-vocoder file :fft-size size)))
-      (run
-       (loop for i from start to end do
-	 (outa i (* amp (phase-vocoder sr)))))))
-
- -

See ug3.ins for instruments that use the various function arguments. In Snd, clm23.scm -has a variety of instruments calling the phase-vocoder generator, including pvoc-e that -specifies all of the functions with their default values (that is, it explicitly passes -in functions that do what the phase-vocoder would have done without any function arguments). -

- - - - - -
nrxycos and nrxysin
- -
-make-nrxysin &optional-key (frequency 0.0) (ratio 1.0) (n 1) (r .5)
-nrxysin s &optional (fm 0.0)
-nrxysin? s
-
-make-nrxycos &optional-key (frequency 0.0) (ratio 1.0) (n 1) (r .5)
-nrxycos s &optional (fm 0.0)
-nrxycos? s
-
- - - - - - - - - -
nrxysin methods
mus-frequency frequency in Hz
mus-phase phase in radians
mus-scaler "a" parameter; sideband scaler
mus-length "n" parameter
mus-increment frequency in radians per sample
mus-offset "ratio" parameter
- -
-(/ (- (sin phase) (* a (sin (- phase (* ratio phase))))
-      (* (expt a (1+ n)) (- (sin (+ phase (* (+ N 1) (* ratio phase))))
-			    (* a (sin (+ phase (* N (* ratio phase))))))))
-   (- (+ 1 (* a a)) (* 2 a (cos (* ratio phase)))))
-
- -

These three generators -produce a kind of additive synthesis. -"n" is the number of sidebands (0 gives a sine wave), "r" is the amplitude -ratio between successive sidebands (don't set it to 1.0), and "ratio" is the ratio between the -carrier frequency and the spacing between successive sidebands. -A "ratio" of 2 gives odd-numbered harmonics for a (vaguely) clarinet-like sound. -The basic idea is very similar to that used in the -ncos generator, but you have control of the -fall-off of the spectrum and the spacing of the partials. -

- -

The peak amplitude of the nrxysin is hard to predict. -I think nrxysin is close to the -1.0..1.0 ideal, and won't go over 1.0. -nrxycos is normalized correctly. -

- -
-(definstrument ss (beg dur freq amp &optional (n 1) (r 0.5) (ratio 1.0))
-  (let* ((st (floor (* *srate* beg)))
-         (nd (+ st (floor (* *srate* dur))))
-         (sgen (make-nrxycos freq ratio n r)))
-    (run
-     (loop for i from st below nd do
-       (outa i (* amp (nrxycos sgen)))))))
-
- - - - - - -
asymmetric-fm
- -
-make-asymmetric-fm &optional-key (frequency 0.0) (initial-phase 0.0) (r 1.0) (ratio 1.0)
-asymmetric-fm af index &optional (fm 0.0)
-asymmetric-fm? af
-
- - - - - - - - -
asymmetric-fm methods
mus-frequency frequency in Hz
mus-phase phase in radians
mus-scaler "r" parameter; sideband scaler
mus-offset "ratio" parameter
mus-increment frequency in radians per sample
- -
-(* (exp (* index (* 0.5 (- r (/ 1.0 r)))
-	   (cos (* ratio phase))))
-   (sin (+ phase (* index (* 0.5 (+ r (/ 1.0 r)))
-		    (sin (* ratio phase))))))
-
- -

asymmetric-fm provides a way around the symmetric spectra normally produced by FM. -See Palamin and Palamin, "A Method of Generating and Controlling Asymmetrical -Spectra" JAES vol 36, no 9, Sept 88, p671-685. -The generator's output amplitude is not always easy to predict. r is the ratio between successive -sideband amplitudes, r > 1.0 pushes energy above the carrier, r < 1.0 pushes it below. (r = 1.0 -gives normal FM). ratio -is the ratio between the carrier and modulator (i.e. sideband spacing). It's somewhat inconsistent -that asymmetric-fm takes index (the fm-index) as its second argument, but otherwise it -would be tricky to get time-varying indices. -

- -
-(definstrument asy (beg dur freq amp index &optional (r 1.0) (ratio 1.0))
-  (let* ((st (floor (* beg *srate*)))
-         (nd (+ st (floor (* dur *srate*))))
-         (asyf (make-asymmetric-fm :r r :ratio ratio :frequency freq)))
-    (run
-     (loop for i from st below nd do
-       (outa i (* amp (asymmetric-fm asyf index 0.0)))))))
-
- -

For the other kind of asymmetric-fm, and for asymmetric spectra via "single sideband FM", see dsp.scm in Snd. -

- - - - -
Other generators
- -

There are a number of other generators in the CLM distribution that aren't -loaded by default. Among these are:

- -
-  rms         ; trace the rms of signal
-  gain        ; modify signal to match rms power
-  balance     ; combination of rms and gain
-
- -

-green.cl defines several special purpose noise generators. -butterworth.cl has several Butterworth filters. -(See analog-filter.scm in the Snd package for functions to design all the usual analog filters; -the output is compatible with the Scheme version of CLM's filter generator). -

- -
generic functions
- -

The generators have internal state that is sometimes of interest at run-time. To get or -set this state, use these functions (they are described in conjunction with the associated generators):

- - - - - - - - - - - - - - - - - - - - - - - - - - - - -
mus-channelchannel being read/written
mus-channelschannels open
mus-dataarray of data
mus-describedescription of current state
mus-feedbackfeedback coefficient
mus-feedforwardfeedforward coefficient
mus-file-namefile being read/written
mus-frequencyfrequency (Hz)
mus-hophop size for block processing
mus-incrementvarious increments
mus-interp-typeinterpolation type (mus-interp-linear, etc)
mus-lengthdata array length
mus-locationsample location for reads/writes
mus-namegenerator name ("oscil")
mus-offsetenvelope offset
mus-orderfilter order
mus-phasephase (radians)
mus-rampgranulate grain envelope ramp setting
mus-resetset gen to default starting state
mus-runrun any generator
mus-scalerscaler, normally on an amplitude
mus-widthwidth of interpolation tables, etc
mus-xcoeffx (input) coefficient
mus-xcoeffsarray of x (input) coefficients
mus-ycoeffy (output, feedback) coefficient
mus-ycoeffsarray of y (feedback) coefficients
- -

Many of these are settable: -(setf (mus-frequency osc1) 440.0) -sets osc1's current frequency to (hz->radians 440.0). -

- -
-(definstrument backandforth (onset duration file src-ratio)
-  ;; read file forwards and backwards until dur is used up
-  ;; a slightly improved version is 'scratch' in ug1.ins
-  (let* ((last-sample (sound-framples file))
-         (beg (floor (* *srate* onset)))
-         (end (+ beg (floor (* *srate* duration))))
-	 (input (make-readin file))
-         (s (make-src :srate src-ratio))
-         (cs 0))
-    (run
-     (loop for i from beg below end do
-       (declare (type :integer cs last-sample)
-		(type :float src-ratio))
-       (if (>= cs last-sample) (setf (mus-increment s) (- src-ratio)))
-       (if (<= cs 0) (setf (mus-increment s) src-ratio))
-       (outa i (src s 0.0 #'(lambda (dir) 
-			      (incf cs dir)
-			      (setf (mus-increment input) dir)
-			      (readin input))))))))
-
-;;; (with-sound () (backandforth 0 10 "pistol.snd" 2.0))
-
- - - - - - -
Sound IO
- -

Sound file IO is supported by a variety of functions. To read and write sound files into an -array, use array->file and file->array. -Within the run-loop, out-any, in-any, and readin -are the simplest input and output generators; locsig provides a sort of sound placement; dlocsig provides -moving sound placement. When you use with-sound, the variable *output* is bound to a sample->file -object, so output by default goes to with-sound's output file. You can open (for reading or -writing) any sound files via make-file->sample (or ->frample), and make-sample->file -(or frample->). These return an IO object which you subsequently pass to file->sample -(for input) and sample->file (for output). To close the connection to the file system, -you can use mus-close, but it's also called automatically during garbage collection, if needed. -

- - - - - - - - - - - - - - - - - - - - - - - - -
mus-input? objt if obj performs sound input
mus-output? objt if obj performs sound output
file->sample? objt if obj reads a sound file returning a sample
sample->file? objt if obj writes a sample to a sound file
frample->file? objt if obj writes a frample to a sound file
file->frample? objt if obj reads a sound file returning a frample
make-file->sample name buffer-sizereturn gen that reads samples from sound file name
make-sample->file name &optional chans format type commentreturn gen that writes samples to sound file name
make-file->frample name buffer-sizereturn gen that reads framples from sound file name
make-frample->file name &optional chans format type commentreturn gen that writes framples to sound file name
file->sample obj samp &optional chanreturn sample at samp in channel chan
sample->file obj samp chan valwrite (add) sample val at samp in channel chan
file->frample obj samp &optional outfreturn frample at samp
frample->file obj samp valwrite (add) frample val at samp
file->array file channel beg dur arrayread samples from file into array
array->file file data len srate channels write samples in array to file
continue-frample->file filereopen file for more output
continue-sample->file filereopen file for more output
mus-close objclose the output file associated with obj
- - - -
out-any
- -
-outa loc data
-out-any loc data &optional (channel 0) (o-stream *output*)
-
- -

out-any adds data into o-stream at sample -position loc. O-stream defaults to the current output -file (it is a frample->file instance, not a file name). The reverb stream, if any, -is named *reverb*; the direct output is *output*. -You can output anywhere at any time, but because of the way data is buffered internally, your -instrument will run much faster if it does sequential output. -Locsig is another output function.

- -

Many of the CLM examples and instruments use outa and outb. -These are macros equivalent to (out-any loc data 0 *output*) etc. -

- - - -
in-any
- -
-in-any loc channel i-stream
-ina loc
-
- -

in-any returns the sample at position loc in -i-stream as a float. -Many of the CLM examples and instruments use ina and inb; one example is -the digital zipper instrument zipper.ins. -

- -
-(definstrument simple-ina (beg dur amp file)
-  (let* ((start (floor (* beg *srate*)))
-	 (end (+ start (floor (* dur *srate*))))
-	 (fil (open-input file)))          ; actually make-file->sample
-    (run
-     (loop for i from start to end do
-       (outa i (* amp (in-any i 0 fil))))) ; actually file->sample
-    (close-input fil)))
-
- - - - - - -
readin
- -
- make-readin &optional-key file (channel 0) start (direction 1)
- readin rd
- readin? rd
-
- - - - - - - - -
readin methods
mus-channel channel arg to make-readin (no setf)
mus-location current location in file
mus-increment sample increment (direction arg to make-readin)
mus-file-name name of file associated with gen
mus-length number of framples in file associated with gen
- -

readin returns successive samples from file. -file should be either an IO instance, as returned by open-input, -or a filename. -start is the frample at which to start reading file. -channel is which channel to read (0-based). -size is the read buffer size in samples. It defaults to *clm-file-buffer-size*. -Here is an instrument that applies an envelope to a sound file using -readin and env (see also the fullmix instrument in fullmix.ins): -

- -
-(definstrument env-sound (file beg &optional (amp 1.0) (amp-env '(0 1 100 1)))
-  (let* ((st (floor (* beg *srate*)))
-         (dur (sound-duration file))
-         (rev-amount .01)
-         (rdA (make-readin file))
-         (ampf (make-env amp-env amp dur))
-         (nd (+ st (floor (* *srate* dur)))))
-    (run
-      (loop for i from st below nd do
-        (let ((outval (* (env ampf) (readin rdA))))
-  	  (outa i outval)
-	  (if *reverb* (outa i (* outval rev-amount) *reverb*)))))))
-
- - - - - - - - -
locsig
- -
- make-locsig &optional-key (degree 0.0) (distance 1.0) (reverb 0.0) channels (type *clm-locsig-type*)
- locsig loc i in-sig
- locsig? loc
- locsig-ref loc chan
- locsig-set! loc chan val
- locsig-reverb-ref loc chan
- locsig-reverb-set! loc chan val
- move-locsig loc degree distance
- locsig-type ()
-
- - - - - - - - -
locsig methods
mus-data output scalers (a vct)
mus-xcoeff reverb scaler
mus-xcoeffs reverb scalers (a vct)
mus-channels output channels
mus-length output channels
- -

locsig normally takes the place of out-any in an -instrument. It tries to place a signal between channels 0 and 1 (or 4 channels placed in a circle) in -an extremely dumb manner: it just scales the respective amplitudes -("that old trick never works"). reverb determines how much of -the direct signal gets sent to the reverberator. distance tries to -imitate a distance cue by fooling with the relative amounts of direct and -reverberated signal (independent of reverb). distance should -be greater than or equal to 1.0. -type (returned by the function locsig-type) can be mus-interp-linear (the default) or mus-interp-sinusoidal. -This parameter can be set globally via *clm-locsig-type*. The mus-interp-sinusoidal -case uses sin and cos to set the respective channel amplitudes (this is reported to -help with the "hole-in-the-middle" problem). -

- -

Locsig is a -kludge, but then so is any pretence of placement when you're piping the signal -out a loudspeaker. It is my current belief that locsig does the right -thing for all the wrong reasons; a good concert hall provides auditory -spaciousness by interfering with the ear's attempt to localize a sound. -A diffuse sound source is the ideal! By sending an arbitrary mix of -signal and reverberation to various speakers, locsig gives you a very -diffuse source; it does the opposite of what it claims to do, and by -some perversity of Mother Nature, that is what you want. (See "Binaural -Phenomena" by J Blauert). -

- -

Locsig can send output to any number of channels. -If channels > 2, the speakers are assumed to be evenly spaced in -a circle. -You can use locsig-set! and locsig-ref to override the placement decisions. -To have full output to both channels,

- -
-(setf (locsig-ref loc 0) 1.0) ; or (locsig-set! loc 0 1.0)
-(setf (locsig-ref loc 1) 1.0)
-
- -

These locations can be set via envelopes and so on within the run -loop to pan between speakers (but see move-locsig below):

- -
-(definstrument space (file onset duration &key (distance-env '(0 1 100 10)) (amplitude-env '(0 1 100 1))
-		     (degree-env '(0 45 50 0 100 90)) (reverb-amount .05))
-  (let* ((beg (floor (* onset *srate*)))
-	 (end (+ beg (floor (* *srate* duration))))
-         (loc (make-locsig :degree 0 :distance 1 :reverb reverb-amount))
-         (rdA (make-readin :file file))
-         (dist-env (make-env distance-env :duration duration))
-         (amp-env (make-env amplitude-env :duration duration))
-         (deg-env (make-env (scale-envelope degree-env (/ 1.0 90.0)) :duration duration))
-         (dist-scaler 0.0))
-    (run
-      (loop for i from beg below end do
-        (let ((rdval (* (readin rdA) (env amp-env)))
-	      (degval (env deg-env))
-	      (distval (env dist-env)))
-          (setf dist-scaler (/ 1.0 distval))
-          (setf (locsig-ref loc 0) (* (- 1.0 degval) dist-scaler))
-          (if (> (mus-channels *output*) 1) (setf (locsig-ref loc 1) (* degval dist-scaler)))
-          (when *reverb* (setf (locsig-reverb-ref loc 0) (* reverb-amount (sqrt dist-scaler))))
-          (locsig loc i rdval))))))
-
- -

For a moving sound -source, see either move-locsig, or Fernando Lopez Lezcano's dlocsig. -Here is an example of move-locsig: -

- -
-(definstrument move-osc (start dur freq amp &key (degree 0) (dist 1.0) (reverb 0))
-  (let* ((beg (floor (* start *srate*)))
-         (end (+ beg (floor (* dur *srate*))) )
-         (car (make-oscil :frequency freq))
-         (loc (make-locsig :degree degree :distance dist :channels 2))
-	 (pan-env (make-env '(0 0 1 90) :duration dur)))
-    (run
-     (loop for i from beg to end do
-       (let ((ut (* amp (oscil car))))
-	 (move-locsig loc (env pan-env) dist)
-         (locsig loc i ut))))))
-
- - - - - - -
move-sound
- -
- make-move-sound dlocs-list (output *output*) (revout *reverb*)
- move-sound dloc i in-sig
- move-sound? dloc
-
- -

move-sound is intended as the run-time portion of dlocsig. make-dlocsig (described in -dlocsig.html) creates a move-sound structure, passing it to the move-sound generator inside the -dlocsig macro. All the necessary data is packaged up in a list: -

- -
-(list
-  (start 0)               ; absolute sample number at which samples first reach the listener
-  (end 0)                 ; absolute sample number of end of input samples
-  (out-channels 0)        ; number of output channels in soundfile
-  (rev-channels 0)        ; number of reverb channels in soundfile
-  path                    ; interpolated delay line for doppler
-  delay                   ; tap doppler env
-  rev                     ; reverberation amount
-  out-delays              ; delay lines for output channels that have additional delays
-  gains                   ; gain envelopes, one for each output channel
-  rev-gains               ; reverb gain envelopes, one for each reverb channel
-  out-map)                ; mapping of speakers to output channels
-
- -

Here's an instrument that uses this generator to pan a sound through four channels: -

- -
-(definstrument simple-dloc (beg dur freq amp)
-  (let* ((os (make-oscil freq))
-	 (start (floor (* beg *srate*)))
-	 (end (+ start (floor (* dur *srate*))))
-	 (loc (make-move-sound (list start end 4 0
-				     (make-delay 12) 
-				     (make-env '(0 0 10 1) :duration dur)
-				     (make-env '(0 0 1 0) :duration dur)
-				     (make-array 4 :initial-element nil)
-				     (make-array 4 :initial-contents 
-				       (list
-					(make-env '(0 0 1 1 2 0 3 0 4 0) :duration dur)
-					(make-env '(0 0 1 0 2 1 3 0 4 0) :duration dur)
-					(make-env '(0 0 1 0 2 0 3 1 4 0) :duration dur)
-					(make-env '(0 0 1 0 2 0 3 0 4 1) :duration dur)))
-				     nil
-				     (make-integer-array 4 :initial-contents (list 0 1 2 3))))))
-    (run
-     (loop for i from start to end do
-       (move-sound loc i (* amp (oscil os)))))))
-
- - - -
Useful functions
- -

There are several commonly-used functions, some of which can occur in the run macro. These include -a few that look for all the world like generators.

- - - - - - - - - - - - - - - - - - - - - - - - -
hz->radians freqconvert freq to radians per sample
radians->hz radsconvert rads to Hz
db->linear dBconvert dB to linear value
linear->db valconvert val to dB
times->samples start durationconvert start and duration from seconds to samples (beg+dur in latter case)
samples->seconds sampsconvert samples to seconds
seconds->samples secsconvert seconds to samples
degrees->radians degsconvert degrees to radians
radians->degrees radsconvert radians to degrees
clear-array arrset all values in arr to 0.0
sound-samples filenamesamples of sound according to header (can be incorrect)
sound-framples filenameframples per channel
sound-datum-size filenamebytes per sample
sound-data-location filenamelocation of first sample (bytes)
sound-chans filenamenumber of channels (samples are interleaved)
sound-srate filenamesampling rate
sound-header-type filenameheader type (aiff etc)
sound-data-format filenamedata format (alaw etc)
sound-length filenametrue file length (for error checks)
sound-duration filenamefile length in seconds
sound-maxamp name valsget max amp vals and times of file name
sound-loop-info name valsget loop info of file name in vals (make-integer-array 6)
- -

-hz->radians -converts its argument to radians/sample (for any situation where a -frequency is used as an amplitude, glissando or FM). It -can be used within run. hz->radians is equivalent to -

- -
-  freq-in-hz * 2 * pi / *srate*.  
-
- -
-

-Freq-in-hz * 2 * pi gives us the number of radians traversed per -second; we then divide by the number of samples per second to get the -radians per sample; in dimensional terms: (radians/sec) / -(sample/sec) = radians/sample. We need this conversion whenever a -frequency-related value is actually being accessed on every sample, as -an increment of a phase variable. (We are also assuming -our wave table size is 2 * pi). This conversion value was named "mag" -in Mus10 and "in-hz" in CLM-1. The inverse is radians->hz. -

- -

These names are different from the underlying sndlib names mostly due -to confusion and inattention. Nearly all the sndlib constants and functions -are imported into clm under names that are the same as the C name except -"_" is replaced by "-". So mus-sound-duration exists, -and is the same as sound-duration mentioned above. See sndlib.html -for some info. -(mus-sound-srate (mus-file-name *output*)) -for example, returns the -current output sampling rate; this is the same as *srate*. -

- - - - - -
polynomial
- -
-polynomial coeffs x
-
- -

polynomial evaluates a polynomial, defined by giving its coefficients, -at a particular point (x). -coeffs is an array of coefficients where -coeffs[0] is the constant term, and so on. For -waveshaping, use the function partials->polynomial. -Abramowitz and Stegun, "A Handbook of Mathematical Functions" is a -treasure-trove of interesting polynomials. -See also the brighten instrument. -

- - - - - - -
array-interp and dot-product
- -
-array-interp fn x &optional size
-dot-product in1 in2
-edot-product freq data [Scheme/C versions]
-mus-interpolate type x v size y1
-
- -

These functions underlie some of the generators, and can be -called within run. See mus.lisp for -details. array-interp can be used for companding and similar functions — -load the array (call it "compander" below) with the positive half -of the companding function, then: -

- -
-  (let ((in-val (readin rd))            ; in-coming signal
-        (func-len (length compander)))  ; size of array
-    (* (signum in-val) 
-       (array-interp compander (abs (* in-val (1- func-len))) func-len)))
-
- -

-dot-product is the usual "inner product" or "scalar product". -

- -

-mus-interpolate is the function used whenever table lookup interpolation is requested, as in -delay or wave-train. The type is one of the interpolation types (mus-interp-linear, for example). -

- - - - - -
contrast-enhancement
- -
- contrast-enhancement in-samp &optional (fm-index 1.0)
-
- -

contrast-enhancement phase-modulates a sound file. It's like audio MSG. -The actual algorithm is sin(in-samp * pi/2 + -(fm-index * sin(in-samp * 2*pi))). The result is to brighten the -sound, helping it cut through a huge mix.

- -

-Waveshaping can provide a similar effect:

- -
-(definstrument brighten (start duration file file-maxamp partials)
-  (multiple-value-bind (beg end) (times->samples start duration)
-    (let ((fil (open-input* file)))
-      (when fil
-        (unwind-protect
-	  (let ((coeffs (partials->polynomial (normalize-partials partials)))
-		(rd (make-readin fil)))
-	    (run (loop for i from beg below end do
-		   (outa i (* file-maxamp (polynomial coeffs (/ (readin rd) file-maxamp)))))))
-	  (close-input fil))))))
-
-(with-sound () (brighten 0 3 "oboe" .15 '(1 1 3 .5 7 .1)))
-
- -

In this case, it is important to scale the file input to the waveshaper to go from --1.0 to 1.0 to get the full effect of the Chebyshev polynomials. Unfortunately, -if you don't add an overall amplitude envelope to bring the output to 0, you'll -get clicks if you include even numbered partials. These partials create a non-zero -constant term in the polynomial, so when the sound decays to 0, the polynomial -output decays to some (possibly large) non-zero value. In the example above, -I've used only odd partials for this reason. Another thing to note here is that -the process is not linear; that is the sinusoids that make up the input are not -independently expanded into the output spectrum, but instead you get sum and difference -tones, (not to mention phase cancellations) much as in FM with a complex wave. -

- - - - - - -
ring-modulate and amplitude-modulate
- -
-ring-modulate in1 in2
-amplitude-modulate am-carrier input1 input2
-
- -ring-modulate returns (* in1 in2). -amplitude-modulate returns (* input1 (+ am-carrier input2)) - -

ring-modulation is sometimes called "double-sideband-suppressed-carrier" modulation — -that is, amplitude modulation with the carrier subtracted out (set to 0.0 above). -The nomenclature here is a bit confusing — I can't remember now why I used -these names; think of "carrier" as "carrier amplitude" and "input1" as "carrier". Normal amplitude modulation using this function would be: -

- -
-(defvar carrier (make-oscil carrier-freq (* .5 pi)))
-...
-(amplitude-modulate 1.0 (oscil carrier) signal)
-
- -

-Since neither needs any state information, there are no associated make -functions.

- -

Both of these take advantage of the "Modulation Theorem"; since -multiplying a signal by e^(iwt) translates its spectrum by w / -two-pi Hz, multiplying by a sinusoid splits its spectrum into two equal parts -translated up and down by w/two-pi Hz. The simplest case is:

- -
-cos f1 * cos f2 = (cos (f1 + f2) + cos (f1 - f2)) / 2.
-
- -

We can use these to shift all the components of a signal by the same -amount up or down ("single-sideband modulation"). -

- - - - - - -
FFT
- -
-fft rdat idat fftsize &optional sign
-make-fft-window &optional-key type size (beta 0.0) (alpha 0.0)
-rectangular->polar rdat idat
-rectangular->magnitudes rdat idat
-polar->rectangular rdat idat
-spectrum rdat idat window norm-type
-convolution rdat idat size
-autocorrelate dat1 size
-correlate dat1 dat2 size
-
- -

These provide run-time access to the standard fft routines and their habitual companions. -make-fft-window can return many of the standard windows including:

- -
-  rectangular-window   ; no change in data
-  bartlett-window      ; triangle
-  parzen-window        ; raised triangle
-  welch-window         ; parzen squared
-  hann-window          ; cosine (sometimes known as "hanning-window" — a sort of in-joke)
-  hamming-window       ; raised cosine
-  blackman2-window     ; Blackman-Harris windows of various orders
-  blackman3-window
-  blackman4-window     ; also blackman5..10
-  exponential-window
-  kaiser-window        ; beta argument used here
-
- -

The -magnitude of the spectrum is returned by rectangular->polar. -spectrum calls the fft, translates to polar coordinates, -then returns the results (in the lower half of "rdat") in dB (norm-type = 0), or linear normalized to 1.0 (norm-type = 1), -or linear unnormalized (norm-type not 0 or 1). -

- -

The following instrument implements fft overlap-add, but instead -of scaling the various spectral components to filter a sound, it reverses a portion -of the spectrum, a distortion that can be effective with speech sounds.

- -
-(definstrument inside-out (beg dur file amp lo hi &optional (fftsize 1024))
-  ;; fft overlap-add (and buffer), but the fft bins between lo and hi are reversed
-  (let ((fil (open-input* file)))
-    (when fil
-      (unwind-protect
-        (let* ((start (floor (* beg *srate*)))
-               (end (+ start (floor (* dur *srate*))))
-               (fdr (make-double-float-array fftsize))
-               (fdi (make-double-float-array fftsize))
-               (wtb (make-double-float-array fftsize))
-               (filptr 0)
-               (fft2 (floor fftsize 2))
-               (fft4 (floor fftsize 4))
-               (ctr fft2)
-               (fftn (/ 1.0 fftsize))
-               (first-time 1)
-               (mid (* .5 (+ hi lo))))
-	  (when (zerop lo) (setf lo 1))
-          (run
-           (loop for i from start below end do
-             (when (= ctr fft2)
-               (clear-array fdr)
-               (clear-array fdi)
-               (dotimes (k fft2)
-                 (setf (aref fdr (+ k fft4)) (* (ina filptr fil) fftn))
-                 (incf filptr))
-               (fft fdr fdi fftsize 1)
-               (let ((j1 hi) ; now reverse bins between lo and hi
-                     (k0 (- fftsize lo))
-                     (k1 (- fftsize hi)))
-                 (loop for j0 from lo to mid do
-                   (let ((tmprj (aref fdr j0))
-                         (tmprk (aref fdr k0))
-                         (tmpij (aref fdi j0))
-                         (tmpik (aref fdi k0)))
-                     (setf (aref fdr j0) (aref fdr j1))
-                     (setf (aref fdr j1) tmprj)
-                     (setf (aref fdr k0) (aref fdr k1))
-                     (setf (aref fdr k1) tmprk)
-                     (setf (aref fdi j0) (aref fdi j1))
-                     (setf (aref fdi j1) tmpij)
-                     (setf (aref fdi k0) (aref fdi k1))
-                     (setf (aref fdi k1) tmpik)
-                     (incf k1)
-                     (decf k0)
-                     (decf j1))))
-               (fft fdr fdi fftsize -1)
-               (dotimes (k fft2)
-                 (setf (aref wtb k) (aref wtb (+ k fft2)))
-                 (setf (aref wtb (+ k fft2)) 0.0))
-               (if (= first-time 1)
-                   (progn
-                     (dotimes (k fftsize) (setf (aref wtb k) (aref fdr k)))
-                     (setf first-time 0)
-		     (setf ctr fft4))
-                 (progn
-                   (dotimes (k fft2) (incf (aref wtb k) (aref fdr k)))
-                   (dotimes (k fft2) (setf (aref wtb (+ k fft2)) (aref fdr (+ k fft2))))
-		   (setf ctr 0))))
-             (outa i (* amp (aref wtb ctr)))
-             (incf ctr))))
-        (close-input fil)))))
-
-(with-sound () (inside-out 0 1.0 "fyow" 1.0 3 8))
-
- -

There are many other examples of run-time FFTs: -the cross-synthesis instrument above, -san.ins, -and anoi.ins. -

- - - -
def-clm-struct
- -

def-clm-struct is syntactically like def-struct, but sets up -the struct field names for the run macro. There are several examples in prc-toolkit95.lisp, and other instruments. -The fields can only be of a numerical type (no generators, for example). -

- - -
Definstrument
- - -

definstrument defines an instrument in CLM. -Its syntax is almost the same as defun; it has a few bizarre options (for miserable -historical reasons), but they should be resolutely ignored. -There are a bazillion example instruments included in CLM and Snd. -The following instruments live in *.ins files in the CLM -directory (see also the file ins), and in various -*.scm, *.rb, and *.fs files in the Snd tarball. If you're reading this -file from outside ccrma, and the instrument url has snd/snd, change that -to clm/clm. -

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
instrumentfunctionCLSchemeRubyForth
complete-addadditive synthesisadd.ins
addfltsfiltersaddflt.insdsp.scmdsp.rb
add-soundmix in a sound fileaddsnd.ins
bullfrog et almany animals (frogs, insects, birds)animals.scm
anoinoise reductionanoi.insclm-ins.scmclm-ins.rbclm-ins.fs
autocpitch estimation (Bret Battey)autoc.ins
baddfancier additive synthesis (Doug Fulton)badd.ins
bandedwgJuan Reyes banded waveguide instrumentbandedwg.insbandedwg.cms
fm-bellfm bell sounds (Michael McNabb)bell.insclm-ins.scmclm-ins.rbclm-ins.fs
bigbirdwaveshapingbigbird.insbird.scmbird.rbclm-ins.fs, bird.fs
singbowlJuan Reyes Tibetan bowl instrumentbowl.insbowl.cms
canterfm bagpipes (Peter Commons)canter.insclm-ins.scmclm-ins.rbclm-ins.fs
cellonfeedback fm (Stanislaw Krupowicz)cellon.insclm-ins.scmclm-ins.rbclm-ins.fs
cnvrevconvolution (aimed at reverb)cnv.insclm-ins.scm
moving soundssound movement (Fernando Lopez-Lezcano)dlocsig.lispdlocsig.scmdlocsig.rb
droneadditive synthesis (bag.clm) (Peter Commons)drone.insclm-ins.scmclm-ins.rbclm-ins.fs
expandngranular synthesis (Michael Klingbeil)expandn.insclm-ins.scm
granulate-soundexamples granular synthesisexpsrc.insclm-ins.scmclm-ins.rbclm-ins.fs
cross-fadecross-fades in the frequency domainfade.insfade.scm
filter-soundfilter a sound filefltsnd.insdsp.scm
stereo-flutephysical model of a flute (Nicky Hind)flute.insclm-ins.scmclm-ins.rbclm-ins.fs
fm examplesfm bell, gong, drum (Paul Weineke, Jan Mattox)fmex.insclm-ins.scmclm-ins.rbclm-ins.fs
Jezar's reverbfancy reverb (Jezar Wakefield)freeverb.insfreeverb.scmfreeverb.rbclm-ins.fs
fofinsFOF synthesissndclm.htmlclm-ins.scmclm-ins.rbclm-ins.fs
fullmixa mixerfullmix.insclm-ins.scmclm-ins.rbclm-ins.fs
granigranular synthesis (Fernando Lopez-Lezcano)grani.insgrani.scm
grapheqgraphic equalizer (Marco Trevisani)grapheq.insclm-ins.scmclm-ins.rbclm-ins.fs
fm-insectfminsect.insclm-ins.scmclm-ins.rb
jc-reverba reverberator (see also jlrev)jcrev.insjcrev.scmclm-ins.rbclm-ins.fs
fm-voicefm voice (John Chowning)jcvoi.insjcvoi.scm
kipreva fancier reverberator (Kip Sheeline)kiprev.ins
lbj-pianoadditive synthesis piano (Doug Fulton)lbjPiano.insclm-ins.scmclm-ins.rbclm-ins.fs
rotatesJuan Reyes Leslie instrumentleslie.insleslie.cms
maracaPerry Cook's maraca physical modelsmaraca.insmaraca.scmmaraca.rb
maxfilterJuan Reyes modular synthesismaxf.insmaxf.scmmaxf.rb
mlb-voicefm voice (Marc LeBrun)mlbvoi.insclm-ins.scmclm-ins.rbclm-ins.fs
moog filtersMoog filters (Fernando Lopez-Lezcano)moog.lispmoog.scm
fm-noisenoise makernoise.insnoise.scmnoise.rbclm-ins.fs
nreva popular reverberator (Michael McNabb)nrev.insclm-ins.scmclm-ins.rbclm-ins.fs
one-cut"cut and paste" (Fernando Lopez-Lezcano)one-cut.ins
pScott van Duyne's piano physical modelpiano.inspiano.scmpiano.rb
pluckKarplus-Strong synthesis (David Jaffe)pluck.insclm-ins.scmclm-ins.rbclm-ins.fs
pqwwaveshapingpqw.insclm-ins.scmclm-ins.rbclm-ins.fs
pqw-voxwaveshaping voicepqwvox.insclm-ins.scmclm-ins.rbclm-ins.fs
physical modelsphysical modelling (Perry Cook)prc-toolkit95.lispprc95.scmprc95.rbclm-ins.fs
various insfrom Perry Cook's Synthesis Toolkitprc96.insclm-ins.scmclm-ins.rbclm-ins.fs
pvocphase vocoder (Michael Klingbeil)pvoc.inspvoc.scmpvoc.rb
resfltfilters (Xavier Serra, Richard Karpen)resflt.insclm-ins.scmclm-ins.rbclm-ins.fs
resonfm formants (John Chowning)reson.insclm-ins.scmclm-ins.rbclm-ins.fs
ring-modulatering-modulation of sounds (Craig Sapp)ring-modulate.insexamp.scmexamp.rb
rmsenvrms envelope of sound (Bret Battey)rmsenv.ins
pinsspectral modellingsan.insclm-ins.scmclm-ins.rbclm-ins.fs
scannedJuan Reyes scanned synthesis instrumentscanned.insdsp.scm
scentroidspectral scentroid envelope (Bret Battey)scentroid.insdsp.scm
shepardShepard tones (Juan Reyes)shepard.inssndscm.html
singerPerry Cook's vocal tract physical modelsinger.inssinger.scmsinger.rb
sndwarpCsound-like sndwarp generator (Bret Battey)sndwarp.inssndwarp.scm
stochasticBill Sack's stochastic synthesis implementationstochastic.insstochastic.scm
bowJuan Reyes bowed string physical modelstrad.insstrad.scmstrad.rb
track-rmsrms envelope of sound file (Michael Edwards)track-rms.ins
fm-trumpetfm trumpet (Dexter Morrill)trp.insclm-ins.scmclm-ins.rbclm-ins.fs
various insgranular synthesis, formants, etcugex.insclm-ins.scmclm-ins.rb
test insCLM regression tests — see clm-test.lispug(1,2,3,4).insclm23.scm
fm-violinfm violin (fmviolin.clm, popi.clm)v.insv.scmv.rbclm-ins.fs
vowelvowels (Michelle Daniels)vowel.ins
voxfm voice (cream.clm)vox.insclm-ins.scmclm-ins.rbclm-ins.fs
zc, zninterpolating delayszd.insclm-ins.scmclm-ins.rbclm-ins.fs
zipperThe 'digital zipper' effect.zipper.inszip.scmzip.rb
- -

The file clm-test.lisp exercises most of these instruments. -If you develop -an interesting instrument that you're willing to share, please send it to me -(bil@ccrma.stanford.edu).

- -

Although all the examples in this document use run followed by a loop, -you can use other constructs instead:

- -
-(definstrument no-loop-1 (beg dur)
-  (let ((o (make-oscil 660)))
-    (run 
-     (let ((j beg)) 
-       (loop for i from 0 below dur do
-	 (outa (+ i j) (* .1 (oscil o))))))))
-
-(definstrument no-loop-2 (beg dur)
-  (let ((o (make-oscil 440)))
-    (run
-     (dotimes (k dur)
-       (outa (+ k beg) (* .1 (oscil o)))))))
-
- -

And, of course, out-any and locsig can be called any number of times -(including zero) per sample and at any output location. Except in -extreme cases (spraying samples to random locations several seconds -apart), there is almost no speed penalty associated with such output, -so don't feel constrained to write an instrument as a sample-at-a-time loop. -That form was necessary in the old days, so nearly all current instruments -still use it (they are translations of older instruments), but there's no -good reason not to write an instrument such as:

- -
-(definstrument noisey (beg dur)
-  (run
-   (dotimes (i dur)
-     (dotimes (k (random 10))
-       (outa (+ beg (floor (random dur))) (centered-random .01))))))
-
- - - - - -
Note lists
- - - -

A note list in CLM is any lisp expression that opens an output sound file and calls an instrument. The simplest way to -do this is with with-sound or clm-load. -

- - -
with-sound
- -
- with-sound &key 
-   ;; "With-sound: check it out!" — Duane Kuiper, Giants broadcaster after Strawberry homer
-   (output *clm-file-name*)        ; name of output sound file ("test.snd" normally)
-   (channels *clm-channels*)       ; can be any number (defaults to 1, see defaults.lisp)
-   (srate *clm-srate*)             ; also 'sampling-rate' for backwards compatibility
-   continue-old-file               ; open and continue old output file
-   reverb                          ; name of the reverberator, if any.  The reverb
-                                   ;   is a normal clm instrument (see nrev.ins)
-   reverb-data                     ; arguments passed to the reverberator; an unquoted list
-   (reverb-channels *clm-reverb-channels*) ; chans in temp reverb stream (input to reverb)
-   revfile                         ; reverb file name
-   (play *clm-play*)               ; play new sound automatically?
-   (notehook *clm-notehook*)       ; function evaluated on each instrument call
-   (statistics *clm-statistics*)   ; print out various fascinating numbers
-   (decay-time 1.0)                ; ring time of reverb after end of piece
-   comment                         ; comment placed in header (set to :none to squelch comment)
-   info                            ; non-comment header string
-   (header-type *clm-header-type*) ; output file type (see also header types)
-   (data-format *clm-data-format*) ; output data format (see header types)
-   save-body                       ; if t, copy the body (as a string) into the header
-   scaled-to                       ; if a number, scale results to have that max amp
-   scaled-by                       ; scale output by some number
-   (clipped *clm-clipped*)         ; if t, clip output rather than allowing data to wrap-around
-   (verbose *clm-verbose*)         ; some instruments use this to display info during computation
-   (force-recomputation nil)       ; if t, force with-mix calls to recompute
-
- -

with-sound is a macro that performs all the various services needed to -produce and play a sound file; it also wraps an unwind-protect around its body to -make sure that everything is cleaned up properly if you happen to interrupt -computation; at the end it returns the output file name. with-sound opens an -output sound file, evaluates its body (normally a bunch of instrument calls), -applies reverb, if any, as a second pass, and plays the sound, if desired. -The sound file's name defaults to "test.snd" or something similar; use the -output argument to write some other file: -

- -
-  (with-sound (:output "new.wave") (fm-violin 0 1 440 .1))
-
- -

-The channels, srate, data-format, and header-type arguments -set the sound characteristics. The default values for these are set in defaults.lisp. -Reverberation is handled as a second pass through a reverb instrument (nrev.ins for -example). The reverb argument sets the choice of reverberator. -

- -
-(with-sound (:output "new.snd") (simp 0 1 440 .1))
-(with-sound (:srate 44100 :channels 2) ...)
-(with-sound (:reverb jc-reverb) ...)
-(with-sound (:reverb nrev :reverb-data (:reverb-factor 1.2 :lp-coeff .95))...)
-
- - -

With-sound can be called within itself, so you can make an output sound file -for each section of a piece as well as the whole thing, all in one run. Since it is the basis of with-mix and -sound-let, all of these can be nested indefinitely:

- -
-(with-sound () 
-  (mix (with-sound (:output "hiho.snd") 
-            (fm-violin 0 1 440 .1))))
-
-(with-sound ()
-  (with-mix () "s1" 0
-    (sound-let ((tmp ()
-                  (fm-violin 0 1 440 .1)))
-      (mix tmp))))
-
-(with-sound (:verbose t)
-  (with-mix () "s6" 0
-    (sound-let ((tmp ()
-                  (fm-violin 0 1 440 .1))
-                (tmp1 (:reverb nrev)
-                  (mix "oboe.snd")))
-      (mix tmp1)
-      (mix tmp :output-frample *srate*))
-    (fm-violin .5 .1 330 .1)))
-
-(with-sound (:verbose t)
-  (sound-let ((tmp ()
-                (with-mix () "s7" 0
-                  (sound-let ((tmp ()
-                                (fm-violin 0 1 440 .1))
-                              (tmp1 ()
-                                (mix "oboe.snd")))
-                   (mix tmp1)
-                   (mix tmp :output-frample *srate*))
-                 (fm-violin .5 .1 330 .1))))
-    (mix tmp)))
-
- -

You can call with-sound within an instrument:

- -
-(definstrument msnd (beg dur freq amp)
-  (let ((os (make-oscil freq)))
-    (run
-     (loop for i from beg below (+ beg dur) do
-       (outa i (* amp (oscil os)))))))
-
-(definstrument call-msnd (beg dur sr amp)
-  (let* ((temp-file (with-sound (:output "temp.snd") (msnd 0 dur 440.0 .1)))
-	 (tfile (open-input temp-file))
-	 (reader (make-src :input tfile :srate sr))
-	 (new-dur (/ dur sr)))
-    (run
-     (loop for i from beg below (+ beg new-dur) do
-       (outa i (* amp (src reader)))))
-    (close-input tfile)
-    (delete-file temp-file)))
-
- -

-Besides :channels, :reverb, and :srate, the most useful options are :scaled-to and -:statistics. -statistics, if t, causes clm -to keep track of a variety of interesting things and print them out at the end -of the computation. scaled-to tells clm to make sure the final output -file has a maxamp of whatever the argument is to :scaled-to — that is,

- -
-(with-sound (:scaled-to .5) 
-  (dotimes (i 32) (mix "oboe.snd" :output-frample (* i *srate*))))
-
- -

will produce test.snd with a maxamp of .5, no matter how loud the intermediate -mix actually is. -Similarly, the scaled-by argument causes all the output to -be scaled (in amplitude) by its value.

- -
-(with-sound (:scaled-by 2.0) (fm-violin 0 1 440 .1)) 
-
- -

produces a note that is .2 in amplitude. -

- -

If revfile is specfied, but not reverb, the reverb stream is -written to revfile, but not mixed with the direct signal in any way. -Normally the reverb output is not deleted by with-sound; you can set -*clm-delete-reverb* to t to have it deleted automatically. -

- -

-The macro scaled-by scales its body by -its first argument (much like with-offset):

- -
-(with-sound () 
-  (fm-violin 0 1 440 .1)
-  (scaled-by 2.0
-    (fm-violin 0 .25 660 .1)) ; actual amp is .2
-  (fm-violin .5 440 .1))
-
- -

There is also the parallel macro scaled-to. -These are built on the macro with-current-sound -which sets up an embedded with-sound call with all the current with-sound arguments in place -except output, comment, scaled-to, and scaled-by.

- -

Other with-sound options that might need explanation are :notehook and :continue-old-file.

- -

Notehook declares a function that is evaluated each time any instrument is called. -The arguments passed to the notehook function are the current instrument name (a string) and all its -arguments. The following prints out the instrument arguments for any -calls on simp that are encountered:

- -
-(with-sound (:notehook
-              #'(lambda (name &rest args) 
-		  (when (string-equal name "simp")
-	            (print (format nil "(simp ~{~A ~})" args))
-                    (force-output))))
-  (simp 0 1 440 .1)
-  (toot .5 .5 660 .2))
-
- -

If the notehook function returns :done, the instrument exits immediately. -

- -

Continue-old-file, if t, re-opens a previously existing file -for further processing. Normally with-sound clobbers any existing file -of the same name as the output file (see output above). By using -continue-old-file, you can both add new stuff to an existing file, or -(by subtracting) delete old stuff to any degree of selectivity. When you erase -a previous note, remember that the subtraction has to be exact; you have -to create exactly the same note again, then subtract it. By the same token, -you can make a selected portion louder or softer by adding or subtracting a -scaled version of the original. -The option data-format underlies :scaled-to. -CLM can read and write sound data in all the currently popular formats, -leaving aside proprietary compression schemes. The names used in -:data-format can be found in initmus.lisp, -along with the headers CLM knows about.

- -

You can make your own specialized versions of with-sound: -

- -
-(defmacro with-my-sound ((&rest args) &body body)
-  `(let ((filename (with-sound ,args ,.body)))
-     ;; any post-processing you like here
-     filename))
-
- -

One such specialization is with-threaded-sound, -available in sbcl if you built sbcl with threads. -with-threaded-sound looks exactly like with-sound, but -each note (each separate expression in the with-sound body) is handled by a separate thread. -

- -
-(with-threaded-sound ()
-  (fm-violin 0 1 440 .1)
-  (fm-violin 0 1 660 .1))
-
- -

If start a thread for each note, then join them all at once, the computation slows down a lot due to -all the thread overhead, so *clm-threads* sets the number of threads running -through the note list at any one time. It defaults to 4. You can speed up -with-threaded-sound if you set *clm-file-buffer-size* large enough to accommodate -the entire output, then pass :output-safety 1 to with-threaded-sound. -Even so, my tests indicate that -it is sometimes faster to use with-sound; I need to figure out why... -

- -

clm-load is the same as with-sound, but its first argument is the name -of a file containing clm instrument calls (i.e. the body of -with-sound), the reverb argument is the name of the reverb function, -and the reverb-data argument is the list; that is, clm-load's arguments -look like normal lisp, whereas with-sound's are unquoted in these two cases.

- -
-(with-sound (:reverb jc-reverb :reverb-data (:volume .3)) ...)
-(clm-load "test.clm" :reverb 'jc-reverb :reverb-data '(volume .3))
-
- -

The with-sound output is normally sent to the speakers via the play function. -There are several associated functions:

- -
-play &optional file start end wait
-dac &optional file start end wait
-sl-dac file &optional (output-device mus-audio-default)
-stop-playing
-stop-dac
-
- -

play (or dac) starts playing file (or the last file played, if no -argument is given); in some cases (MCL and ACL) it then returns to the lisp listener; -to interrupt the dac in those cases, use stop-playing (or stop-dac). -Currently, play calls the sndplay program if possible; sl-dac is -the same thing, but calls the sl_dac function. The latter gives you control over the -output device (sndplay will also someday). In some cases, sndplay's default buffer -size is not ideal; you can use *clm-player* and sndplay's bufsize argument to -set it to the correct value for your audio system. play's start and end arguments are in seconds, -and default to playing the entire sound. The wait argument in some cases causes -the play call to wait until the complete sound has been played before returning to the listener. -

- -

The *clm-* variables (like *clm-srate*) set the default values. -The corresponding un-clm'd versions (*srate*) hold the current values. So, if -with-sound doesn't include the :srate argument, *srate* is the same as *clm-srate*; -otherwise it reflects the :srate value for the duration of the with-sound call. -The local variables that are currently exported are: -*srate*, *safety*, and *debug*. Unexported, but available in the clm package -are *channels*, *data-format*, *header-type*, *notehook*, *clipped*, *verbose*, -and *statistics*. -

- -
-mus-float-equal-fudge-factor     how far apart values can be and still be considered equal
-mus-array-print-length ()        how many array (vct) elements to print in mus-describe
-mus-file-buffer-size ()          size of input/ouput buffers (default 8192)
-make-fir-coeffs (order spectr)
-mus-srate ()                     current sampling rate
-
- - - - - -
with-mix
- -
-with-mix options file begin &body body
-
- -

With-mix is a macro, callable within with-sound or clm-load, -which saves the computation in its body in a separate file named file -(without the .snd extension), and can tell when that file's data is up to date -and does not need to be recomputed. -

- -
-(with-sound () 
-  (fm-violin 0 .1 440 .1)
-  (with-mix () "sec1" .5 
-    (fm-violin 0 .1 550 .1)
-    (fm-violin .1 .1 660 .1))
-  (with-mix (:reverb jc-reverb) "sec2" 1.0
-    (fm-violin 0 .1 880 .1 :reverb-amount .2)
-    (fm-violin .1 .1 1320 .1 :reverb-amount .2))
-  (fm-violin 2 .1 220 .1)
-  (mix "/zap/slow.snd"))
-
- -

Now, if we change just the first note in the with-mix call, the -second with-mix section will not be recomputed, but will be mixed in from the -saved file "sec2.snd". By surrounding stable sections of a piece with calls on -mix or with-mix, you can save a huge amount of time that would -otherwise be spent waiting for these notes to be recomputed. This check-point -or makefile capability is built on open-input.

- -
-With-mix performs a string comparison of its body to decide whether -it needs to recompute its note calls. It then loads that body from -a separate saved file. This can be confusing if global variables -are present. - -
-  > USER(2): (let ((rstr .1)) (with-sound () (with-mix () "sec" 0 (fm-violin 0 1 440 rstr))))
-  > ; Loading /zap/sec.clm
-  > Error: Attempt to take the value of the unbound variable `RSTR'.
-
- -Here the code evaluated is basically - -(let ((rstr .1)) (load "/zap/sec.clm")) - -where rstr has lexical scope. To make rstr visible within the load, - -
-  (let ((rstr1 .1)) 
-    (declare (special rstr1))
-    (with-sound () (with-mix () "sec" 0 (fm-violin 0 1 440 rstr1))))
-
- -but if you then evaluate the same form again, changing rstr1 to (say) .5, -with-mix does not notice that rstr1's value has changed, so -it does not recompute its body, leaving the resultant amplitude at .1. -
- -

The fastest way to mix sound files is with mix:

- -
-mix &optional-key filename (input-frample 0) (output-frample 0) framples output
-
- - - - -
c-level IO
- - - -
-open-input &optional name &key start channel restartable
-close-input i-stream
-open-input* name &key start channel restartable
-
- -

These functions open and close input sound files. open-input -takes either a string or a pathname and returns an IO object. -Various clm -functions use that object as a handle on the file. The variable -*clm-file-name*, used as the default name in most such calls, is "/zap/test.snd" at CCRMA.

- -

Open-input normally opens the sound file name and returns a list or perhaps a structure -that other clm functions can use to access the file. If you don't -give a complete file name (name without the .snd extension), -open-input checks to see if there's either no .snd file or a later .cm -or .clm file, and in that case, suspends the current computation, makes the -sound file from the sources, then resumes the old computation, opening the -(newly computed) sound file. If you are working in sections, and keep the -sections in separate files, the various layers of mixing can automatically -notice when some section has changed, and update everything for you. -Similarly, if all your sound files get deleted, the whole piece can still -regenerate itself in one operation. -If you want the convenience of the directory -search (see *clm-search-list*) open-input*. -Normally if open-input* can't find a file, it prints a warning and returns -nil. If you would rather that it drop into the debugger with an option -to specify a new file name at that time, set the restartable argument to t. -

- -

Open-input's &key parameters are patterned after Lisp's load -function: -verbose (the default is nil) turns on some informational printout; -element-type can be nil (the default), or :sound. In the latter case, the file passed to -open-input is assumed to contain sound data, no matter what extension it has, providing -a way to override the check for out of date sound files and so on; -if-does-not-exist can be nil or :error (the default). In the latter case, if no sound file -associated with name can be found or created, you get an error message. -start is the sample to start at when reading the first data buffer. -end is the sample to stop at when reading the initial buffer (it defaults to buffer-size). -If you are reading only a small portion of a file many times, you can save some -time by setting explicitly the bounds of the initial read via start and end. -The implicit load triggered by open-input with a non-specific file name -sets -*open-input-pathname* and -*open-input-truename* and notices -*open-input-verbose* (if t, print out informational -messages).

- - - - -
sound-let
- -

sound-let is a form of let* that creates temporary sound streams -within with-sound. Its syntax is like that of let and -with-sound:

- -
-(sound-let ((temp-1 () (fm-violin 0 1 440 .1))
-            (temp-2 () (fm-violin 0 2 660 .1)
-                       (fm-violin .125 .5 880 .1)))
-  (granulate-sound temp-1 0 2 0 2);temp-1's value is the name of the temp file
-  (granulate-sound temp-2 1 1 0 2))
-
- -

This creates two temporary files and passes them along to the subsequent calls -on granulate-sound. The first list after the sound file identifier (i.e. after -"temp-1" in the example) is the list of with-sound options to be passed -along when creating this temporary file. These default to :output -with a unique name generated internally, and all other variables are taken from -the overall (enclosing) output file. The rest of the list is the body of the -associated with-sound, which can contain embedded sound-lets. -The difference between sound-let and a simple embedded with-sound is primarily that -sound-let names and later deletes the temporary files it creates, whereas with-sound leaves -its output intact. -

- - - -
clm defaults
- -

These default values are set in defaults.lisp. Generally, the default value is *clm-<var>, and the -current dynamic value of that variable is *<var>*. -

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*clm-array-print-length*number of IO data buffer elements printed
*clm-channels*default output channels (1)
*clm-clipped*default for clipped arg in with-sound
*clm-dac-wait-default*default choice of whether play function should wait for completion
*clm-data-format*default output sound file data format
*clm-date*creation date of the current version
*clm-delete-reverb*should with-sound delete the temporary reverb output (default nil)
*clm-file-buffer-size*IO buffer sizes (in samples)
*clm-file-name*default sound file name
*clm-header-type*default output sound file header type
*clm-init*name of site-specific initializations (see clm-init.lisp)
*clm-instruments*list of the currently loaded clm instruments
*clm-locsig-type*locsig interpolation choice (mus-interp-linear or mus-interp-sinusoidal)
*clm-news*brief list of recent changes (HISTORY.clm)
*clm-notehook*default for notehook arg in with-sound
*clm-play*default for play arg in with-sound
*clm-player*user-supplied DAC function
*clm-reverb-channels*reverb stream chans in with-sound
*clm-safety*default safety setting (run loop debugging choices)
*clm-search-list*pathname list for file searches (open-input*)
*clm-srate*default sampling rate (44100)
*clm-statistics*default statistics arg in with-sound
*clm-table-size*default table-lookup table size (in Scheme, the associated function is clm-table-size)
*clm-tempfile-data-format*intermediate with-sound file data format
*clm-tempfile-header-type*intermediate with-sound file header type
*clm-version*version identifier (a number — also *clm-revision*)
*output*current output stream (for outa and friends)
*reverb*current reverb stream
two-pi2*pi
- -

*clm-player* can be used to override CLM's normal play routine (which -calls sndplay in most cases). -

- -
-(setf *clm-player* (lambda (name) (clm::run-in-shell "sndplay" (format nil "~A -bufsize 1024" name))))
-
- -

On machines with plenty of memory and slow disks, you can speed up CLM -computations by setting *clm-file-buffer-size* to some number larger -than its default (65536): -

- -
-  (let ((*clm-file-buffer-size* (* 1024 1024))) (with-sound ...) 
-
- -

The macro with-offset can be used to set local -begin time offsets. Its argument is in seconds:

- -
-(with-sound () 
-  (fm-violin 0 1 440 .1)
-  (with-offset 1.0
-    (fm-violin 0 .25 660 .1)) ; actually starts at 1.0
-  (fm-violin .5 440 .1))
-
- - - - -
examples
- -

The file files describes briefly each of the files in the clm -directory; clm-example.lisp shows one way to write notelists; -cm-clm.lisp is -a brief example of using Rick Taube's Common Music to drive CLM. There are several -*.clm files included in the clm distribution. clm-test.lisp runs my standard -set of regression tests, exercising many of the instruments. pitches.cl -provides the standard pitch names as lisp variables (a4 = 440.0 and so on). -

- - - -
run*
- -

run* takes two arguments, a list of variables, and the usual -run macro body. The run body is executed (in C normally) and then -the variables are set to the values they had when the run loop -exited. -This extension of run is -needed because in C -instruments, everything that happens within the run loop is normally hidden -from the lisp interpreter; if you set a global variable's value, for example, -only the run-specific version of that variable is affected. You need run* -to return such values back to Lisp. -

- -
-(definstrument p (beg dur frq amp)
-  (let* ((s (make-oscil frq))
-	 (start (floor (* beg *srate*)))
-	 (end (+ start (floor (* dur *srate*))))
-	 (hi 0.0))
-    (run* (amp hi)
-      (loop for i from start below end do
-	(incf hi .001)
-	(outa i (* amp (oscil s)))))
-    (print (format nil "~A ~A" hi amp))))
-
- -

A more useful instrument is Michael Edwards' track-rms.ins; see also -the sr3 instrument in ug.ins. -Here's another instrument that implements legato between notes by using the previous note's phases: -

- -
-(defstruct fmins carrier modulator)
-(definstrument fmsimp (beg dur frq amp ind &optional previous-oscils)
-  (let* ((start (floor (* *srate* beg)))
-	 (end (+ start (floor (* *srate* dur))))
-	 (carrier (if previous-oscils
-		      (fmins-carrier previous-oscils)
-		    (make-oscil)))
-	 (modulator (if previous-oscils
-			(fmins-modulator previous-oscils)
-		      (make-oscil))))
-    (setf (mus-frequency carrier) frq)
-    (setf (mus-frequency modulator) frq)
-    (run* (carrier modulator)
-     (loop for i from start below end do
-       (outa i (* amp (oscil carrier (* ind (oscil modulator)))))))
-    (if previous-oscils
-	(progn
-	  (setf (fmins-carrier previous-oscils) carrier)
-	  (setf (fmins-modulator previous-oscils) modulator)))))
-
-;;; (defvar oscs (make-fmins :carrier (make-oscil) :modulator (make-oscil)))
-;;; (with-sound () (fmsimp 0 1.01 440 .1 0.0 oscs) (fmsimp 1.01 1 660 .1 0.0 oscs))
-;;; (with-sound () (fmsimp 0 1.01 440 .1 0.0) (fmsimp 1.01 1 660 .1 0.0))
-;;;     the 1.01 (as opposed to 1.0) is needed because the phases line up just by chance in the 1.0 case
-;;;     for portamento, the instrument could notice an in-coming osc set and
-;;;     change the frequency envelope accordingly
-
- - - -
Debugging
- - - -

CLM provides several built-in data display and instrument debugging aids. -But debugging an instrument is still too much pain. I suggest that you -develop the algorithm in Snd/Scheme where there are elaborate and -robust debugging tools. -

- -

The optimize safety option can be used to check for array index and null -generator problems (these will be reported as bus errors and segmentation -faults, sigh). (pushnew :debug *features*) before loading CLM to see what it -is sending to the C compiler. -

- - - -
The error handler
- -

When you hit an error within with-sound, depending on the context of the error and -the lisp you're running, you'll see a variety of restart options:

- -
-  Restart actions (select using :continue):
-   0: return from break.
-   1: try to exit current note cleanly and go on.
-   2: abort current note.
-   3: close files and return to top-level.
-   4: jump past remaining notes.
-
- -

The last four are provided by CLM. The first tries to jump to the end of the -current instrument, allowing open input files to be closed and so forth. -The second jumps out of the current note, but tries to continue processing -the body of with-sound. The third closes all files and jumps out of with-sound. -The fourth jumps to the end of the body of with-sound and tries to handle -all the usual with-sound closing options such as reverb, statistics, and -scaling. -

- -

If you hit a C error (segfault, etc), start gdb with lisp ('gdb /usr/local/lisp/acl'), -'run', load clm, run your instrument, then when the error drops you into the gdb debugger, 'where'. This -should give you some idea where the problem is. In the worst case, trace clm::run-in-shell and compile/load -the instrument to find out what the C compilation sequence is on your machine; next, make whatever changes -you like to the instrument C code (produced by the run macro, named clm_INSNAME.c); to add a print -statement that will send its output to the lisp listener, use the function mus_error with a first argument -of 0; next run the C compiler and loader, making a new instrument object file, start gdb with lisp, run -lisp loading clm, load your instrument, and run it. -

- -

In Windows using ACL, you can get into the debugger via: -

- -
-c:\program files\acl80\mlisp.exe -! -I mlisp.dxl 
-
- -

or some facsimile thereof. When you hit a segfault, get a call stack (stack trace). -I don't know how to print out function arguments in this case. -In ACL, you can maximize the lisp-level information at an error with: -

- -
-:zoom :all t :verbose t :count t
-
- -

ffi-test.lisp has a bunch of FFI calls outside the with-sound/definstrument context. -The base CLM test suite is clm-test.lisp, but it's more of a "regression" test — I run -it in the various lisps whenever I make some code change. -

- - - -
Appendices
- -
header and data types
- - - - - -

CLM can write NeXT/Sun, AIFF/AIFC, RIFF ("wave"), RF64, CAFF, raw (no header), NIST-sphere, and "old-style" IRCAM headers. -The default choice is set by *clm-header-type* -set in defaults.lisp. The output data format is normally -16-bit signed (2's complement) integer; the default is set by -*clm-data-format*. -CLM can read most standard headers, and can read and write most uncompressed -data formats.

- -
-read/write (many data formats):
-
-    NeXT/Sun/DEC/AFsp
-    AIFF/AIFC
-    RIFF (Microsoft wave)
-    RF64
-    IRCAM (old style)
-    NIST-sphere
-    CAFF
-    no header ("raw")
-
-read-only (in selected data formats):
-
-    8SVX (IFF), EBICSF, INRS, ESPS, SPPACK, ADC (OGI), AVR, VOC, PVF,
-    Sound Tools, Turtle Beach SMP, SoundFont 2.0, Sound Designer I, PSION, MAUD, Kurzweil 2000,
-    Gravis Ultrasound, ASF, PAF, CSL, Comdisco SPW, Goldwave sample, omf, quicktime, sox,
-    Sonic Foundry, SBStudio II, Delusion digital, Digiplayer ST3, Farandole Composer WaveSample,
-    Ultratracker WaveSample, Sample Dump exchange, Yamaha SY85, SY99, and TX16, Covox v8, AVI, 
-    Impulse tracker, Korg, Akai, Turtle Beach, Matlab-5
-
-automatically translated to a readable format:
-
-    IEEE text, Mus10, SAM 16-bit (modes 1 and 4), AVI, NIST shortpack, HCOM, Intel, 
-    IBM, and Oki (Dialogic) ADPCM, G721, G723_24, G723_40, MIDI sample dump, Ogg, Speex, 
-    Flac, Midi, Mpeg, Shorten, Wavepack (via external programs)
-
- -

I am willing to add almost anything to this list. -See headers.c for all the gory details. In -with-sound, you can set the output header type with -the keyword :header-type, and the data type with the :data-format keyword.

- -

The CLM names for the output header types, as used with the :header-type argument to with-sound, are -mus-aiff, mus-aifc, mus-next, -mus-riff, mus-rf64, and mus-ircam. -The data-formats -that are exported from the clm package are mus-bshort, mus-lshort, mus-bint, mus-lint, -mus-bfloat, mus-lfloat, mus-mulaw, mus-alaw, mus-byte, mus-ubyte, mus-b24int, mus-l24int, mus-bdouble, -and mus-ldouble. The "b" stands for big-endian, "l" for little-endian, "u" for unsigned. -The other header and data format possibilities are listed in initmus.lisp.

- - - - -

If you are trying to read raw (no header) sound files, CLM's default settings for -the sampling rate, channels, and data format are 44100, 2, and mus-bshort -respectively. To change these, call (mus-set-raw-header-defaults srate chans format): -

- -
-(mus-set-raw-header-defaults 8012 1 mus-mulaw)
-(open-input "raw.snd")
-
- -

treats "raw.snd" as mono µlaw data at 8012 Hz.

- - - -
clm-init.lisp
- - - -

If the file clm-init.lisp exists in the same directory as all.lisp, or -if you set the clm variable *clm-init* to point to some file, then CLM -loads that file upon initialization. -Here is my clm-init.lisp:

- -
-(compile-and-load "v")
-(compile-and-load "jcrev")
-;;; my two favorite instruments
-
-(setf *clm-search-list* 
-  (append *clm-search-list* 
-	  (list "/home/bil/cl/oboe.snd"
-		"/home/bil/test/sounds/test.snd")))
-;;; these are my standard sound file directories — by including 
-;;; these in the search list I don't need to remember where each 
-;;; file happens to be.  The file names are just fillers —
-;;; the important part of the path is the directory.
-
- - - -
saved images
- - - -

Many lisps have some mechanism to dump the current lisp image as an -executable file. In ACL or MCL, some of CLM's state at run-time is handled in C-based -foreign-function modules that are opaque to Lisp, so there are cases where the naive use -of dumplisp (acl), or save-application (mcl) -can fail with a segmentation fault or some other equally -un-informative error message. This should only be a problem when the saved image -has called clm-initialize-links (within with-sound or dac or some such function); -if you build a clm image and immediately save it, everything -should work without problem. Once clm-initialize-links has been called, -the C modules assume they have been initialized; if code in the saved version of -a module is then executed, the un-initialized variables may be accessed. -To get around this problem, call -restart-clm before doing anything in the newly executed image. -

- - - - diff -pruN 19-1/config.rpath 19.0-1/config.rpath --- 19-1/config.rpath 2018-11-23 11:33:45.000000000 +0000 +++ 19.0-1/config.rpath 1970-01-01 00:00:00.000000000 +0000 @@ -1,513 +0,0 @@ -#! /bin/sh -# Output a system dependent set of variables, describing how to set the -# run time search path of shared libraries in an executable. -# -# Copyright 1996-2002 Free Software Foundation, Inc. -# Taken from GNU libtool, 2001 -# Originally by Gordon Matzigkeit , 1996 -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -# -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program that contains a -# configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. -# -# The first argument passed to this file is the canonical host specification, -# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM -# or -# CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM -# The environment variables CC, GCC, LDFLAGS, LD, with_gnu_ld -# should be set by the caller. -# -# The set of defined variables is at the end of this script. - -# All known linkers require a `.a' archive for static linking (except M$VC, -# which needs '.lib'). -libext=a -shlibext= - -host="$1" -host_cpu=`echo "$host" | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'` -host_vendor=`echo "$host" | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'` -host_os=`echo "$host" | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'` - -wl= -if test "$GCC" = yes; then - wl='-Wl,' -else - case "$host_os" in - aix3* | aix4* | aix5*) - wl='-Wl,' - ;; - hpux9* | hpux10* | hpux11*) - wl='-Wl,' - ;; - irix5* | irix6*) - wl='-Wl,' - ;; - linux*) - echo '__INTEL_COMPILER' > conftest.$ac_ext - if $CC -E conftest.$ac_ext >/dev/null | grep __INTEL_COMPILER >/dev/null - then - : - else - # Intel icc - wl='-Qoption,ld,' - fi - ;; - osf3* | osf4* | osf5*) - wl='-Wl,' - ;; - solaris*) - wl='-Wl,' - ;; - sunos4*) - wl='-Qoption ld ' - ;; - sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*) - if test "x$host_vendor" = xsni; then - wl='-LD' - else - wl='-Wl,' - fi - ;; - esac -fi - -hardcode_libdir_flag_spec= -hardcode_libdir_separator= -hardcode_direct=no -hardcode_minus_L=no - -case "$host_os" in - cygwin* | mingw* | pw32*) - # FIXME: the MSVC++ port hasn't been tested in a loooong time - # When not using gcc, we currently assume that we are using - # Microsoft Visual C++. - if test "$GCC" != yes; then - with_gnu_ld=no - fi - ;; - openbsd*) - with_gnu_ld=no - ;; -esac - -ld_shlibs=yes -if test "$with_gnu_ld" = yes; then - case "$host_os" in - aix3* | aix4* | aix5*) - # On AIX, the GNU linker is very broken - ld_shlibs=no - ;; - amigaos*) - hardcode_libdir_flag_spec='-L$libdir' - hardcode_minus_L=yes - # Samuel A. Falvo II reports - # that the semantics of dynamic libraries on AmigaOS, at least up - # to version 4, is to share data among multiple programs linked - # with the same dynamic library. Since this doesn't match the - # behavior of shared libraries on other platforms, we can use - # them. - ld_shlibs=no - ;; - beos*) - if $LD --help 2>&1 | egrep ': supported targets:.* elf' > /dev/null; then - : - else - ld_shlibs=no - fi - ;; - cygwin* | mingw* | pw32*) - # hardcode_libdir_flag_spec is actually meaningless, as there is - # no search path for DLLs. - hardcode_libdir_flag_spec='-L$libdir' - ;; - solaris* | sysv5*) - if $LD -v 2>&1 | egrep 'BFD 2\.8' > /dev/null; then - ld_shlibs=no - elif $LD --help 2>&1 | egrep ': supported targets:.* elf' > /dev/null; then - : - else - ld_shlibs=no - fi - ;; - sunos4*) - hardcode_direct=yes - ;; - *) - if $LD --help 2>&1 | egrep ': supported targets:.* elf' > /dev/null; then - : - else - ld_shlibs=no - fi - ;; - esac - if test "$ld_shlibs" = yes; then - hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' - fi -else - case "$host_os" in - aix3*) - # Note: this linker hardcodes the directories in LIBPATH if there - # are no directories specified by -L. - hardcode_minus_L=yes - if test "$GCC" = yes; then - # Neither direct hardcoding nor static linking is supported with a - # broken collect2. - hardcode_direct=unsupported - fi - ;; - aix4* | aix5*) - if test "$host_cpu" = ia64; then - # On IA64, the linker does run time linking by default, so we don't - # have to do anything special. - aix_use_runtimelinking=no - else - aix_use_runtimelinking=no - # Test if we are trying to use run time linking or normal - # AIX style linking. If -brtl is somewhere in LDFLAGS, we - # need to do runtime linking. - case $host_os in aix4.[23]|aix4.[23].*|aix5*) - for ld_flag in $LDFLAGS; do - if (test $ld_flag = "-brtl" || test $ld_flag = "-Wl,-brtl"); then - aix_use_runtimelinking=yes - break - fi - done - esac - fi - hardcode_direct=yes - hardcode_libdir_separator=':' - if test "$GCC" = yes; then - case $host_os in aix4.[012]|aix4.[012].*) - collect2name=`${CC} -print-prog-name=collect2` - if test -f "$collect2name" && \ - strings "$collect2name" | grep resolve_lib_name >/dev/null - then - # We have reworked collect2 - hardcode_direct=yes - else - # We have old collect2 - hardcode_direct=unsupported - hardcode_minus_L=yes - hardcode_libdir_flag_spec='-L$libdir' - hardcode_libdir_separator= - fi - esac - fi - if test "$aix_use_runtimelinking" = yes; then - hardcode_libdir_flag_spec='${wl}-blibpath:$libdir:/usr/lib:/lib' - else - if test "$host_cpu" = ia64; then - hardcode_libdir_flag_spec='${wl}-R $libdir:/usr/lib:/lib' - else - hardcode_libdir_flag_spec='${wl}-bnolibpath ${wl}-blibpath:$libdir:/usr/lib:/lib' - fi - fi - ;; - amigaos*) - hardcode_libdir_flag_spec='-L$libdir' - hardcode_minus_L=yes - # see comment about different semantics on the GNU ld section - ld_shlibs=no - ;; - cygwin* | mingw* | pw32*) - # When not using gcc, we currently assume that we are using - # Microsoft Visual C++. - # hardcode_libdir_flag_spec is actually meaningless, as there is - # no search path for DLLs. - hardcode_libdir_flag_spec=' ' - libext=lib - ;; - darwin* | rhapsody*) - hardcode_direct=yes - ;; - freebsd1*) - ld_shlibs=no - ;; - freebsd2.2*) - hardcode_libdir_flag_spec='-R$libdir' - hardcode_direct=yes - ;; - freebsd2*) - hardcode_direct=yes - hardcode_minus_L=yes - ;; - freebsd*) - hardcode_libdir_flag_spec='-R$libdir' - hardcode_direct=yes - ;; - hpux9* | hpux10* | hpux11*) - hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir' - hardcode_libdir_separator=: - hardcode_direct=yes - hardcode_minus_L=yes # Not in the search PATH, but as the default - # location of the library. - ;; - irix5* | irix6*) - hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' - hardcode_libdir_separator=: - ;; - netbsd*) - hardcode_libdir_flag_spec='-R$libdir' - hardcode_direct=yes - ;; - newsos6) - hardcode_direct=yes - hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' - hardcode_libdir_separator=: - ;; - openbsd*) - hardcode_direct=yes - if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then - hardcode_libdir_flag_spec='${wl}-rpath,$libdir' - else - case "$host_os" in - openbsd[01].* | openbsd2.[0-7] | openbsd2.[0-7].*) - hardcode_libdir_flag_spec='-R$libdir' - ;; - *) - hardcode_libdir_flag_spec='${wl}-rpath,$libdir' - ;; - esac - fi - ;; - os2*) - hardcode_libdir_flag_spec='-L$libdir' - hardcode_minus_L=yes - ;; - osf3*) - hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' - hardcode_libdir_separator=: - ;; - osf4* | osf5*) - if test "$GCC" = yes; then - hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' - else - # Both cc and cxx compiler support -rpath directly - hardcode_libdir_flag_spec='-rpath $libdir' - fi - hardcode_libdir_separator=: - ;; - sco3.2v5*) - ;; - solaris*) - hardcode_libdir_flag_spec='-R$libdir' - ;; - sunos4*) - hardcode_libdir_flag_spec='-L$libdir' - hardcode_direct=yes - hardcode_minus_L=yes - ;; - sysv4) - if test "x$host_vendor" = xsno; then - hardcode_direct=yes # is this really true??? - else - hardcode_direct=no # Motorola manual says yes, but my tests say they lie - fi - ;; - sysv4.3*) - ;; - sysv5*) - hardcode_libdir_flag_spec= - ;; - uts4*) - hardcode_libdir_flag_spec='-L$libdir' - ;; - dgux*) - hardcode_libdir_flag_spec='-L$libdir' - ;; - sysv4*MP*) - if test -d /usr/nec; then - ld_shlibs=yes - fi - ;; - sysv4.2uw2*) - hardcode_direct=yes - hardcode_minus_L=no - ;; - sysv5uw7* | unixware7*) - ;; - *) - ld_shlibs=no - ;; - esac -fi - -# Check dynamic linker characteristics -libname_spec='lib$name' -sys_lib_dlsearch_path_spec="/lib /usr/lib" -sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib" -case "$host_os" in - aix3*) - shlibext=so - ;; - aix4* | aix5*) - shlibext=so - ;; - amigaos*) - shlibext=ixlibrary - ;; - beos*) - shlibext=so - ;; - bsdi4*) - shlibext=so - sys_lib_search_path_spec="/shlib /usr/lib /usr/X11/lib /usr/contrib/lib /lib /usr/local/lib" - sys_lib_dlsearch_path_spec="/shlib /usr/lib /usr/local/lib" - ;; - cygwin* | mingw* | pw32*) - case $GCC,$host_os in - yes,cygwin*) - shlibext=dll.a - ;; - yes,mingw*) - shlibext=dll - sys_lib_search_path_spec=`$CC -print-search-dirs | grep "^libraries:" | sed -e "s/^libraries://" -e "s/;/ /g"` - ;; - yes,pw32*) - shlibext=dll - ;; - *) - shlibext=dll - ;; - esac - ;; - darwin* | rhapsody*) - shlibext=dylib - ;; - freebsd1*) - ;; - freebsd*) - shlibext=so - ;; - gnu*) - shlibext=so - ;; - hpux9* | hpux10* | hpux11*) - shlibext=sl - ;; - irix5* | irix6*) - shlibext=so - case "$host_os" in - irix5*) - libsuff= shlibsuff= - ;; - *) - case $LD in - *-32|*"-32 ") libsuff= shlibsuff= ;; - *-n32|*"-n32 ") libsuff=32 shlibsuff=N32 ;; - *-64|*"-64 ") libsuff=64 shlibsuff=64 ;; - *) libsuff= shlibsuff= ;; - esac - ;; - esac - sys_lib_search_path_spec="/usr/lib${libsuff} /lib${libsuff} /usr/local/lib${libsuff}" - sys_lib_dlsearch_path_spec="/usr/lib${libsuff} /lib${libsuff}" - ;; - linux-gnuoldld* | linux-gnuaout* | linux-gnucoff*) - ;; - linux-gnu*) - shlibext=so - ;; - netbsd*) - shlibext=so - ;; - newsos6) - shlibext=so - ;; - openbsd*) - shlibext=so - ;; - os2*) - libname_spec='$name' - shlibext=dll - ;; - osf3* | osf4* | osf5*) - shlibext=so - sys_lib_search_path_spec="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib" - sys_lib_dlsearch_path_spec="$sys_lib_search_path_spec" - ;; - sco3.2v5*) - shlibext=so - ;; - solaris*) - shlibext=so - ;; - sunos4*) - shlibext=so - ;; - sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*) - shlibext=so - case "$host_vendor" in - motorola) - sys_lib_search_path_spec='/lib /usr/lib /usr/ccs/lib' - ;; - esac - ;; - uts4*) - shlibext=so - ;; - dgux*) - shlibext=so - ;; - sysv4*MP*) - if test -d /usr/nec; then - shlibext=so - fi - ;; -esac - -sed_quote_subst='s/\(["`$\\]\)/\\\1/g' -escaped_wl=`echo "X$wl" | sed -e 's/^X//' -e "$sed_quote_subst"` -escaped_hardcode_libdir_flag_spec=`echo "X$hardcode_libdir_flag_spec" | sed -e 's/^X//' -e "$sed_quote_subst"` -escaped_sys_lib_search_path_spec=`echo "X$sys_lib_search_path_spec" | sed -e 's/^X//' -e "$sed_quote_subst"` -escaped_sys_lib_dlsearch_path_spec=`echo "X$sys_lib_dlsearch_path_spec" | sed -e 's/^X//' -e "$sed_quote_subst"` - -sed -e 's/^\([a-zA-Z0-9_]*\)=/acl_cv_\1=/' <>confdefs.h + + XEN_CFLAGS="-fPIC `$PKG_CONFIG ruby-2.6 --cflags`" + # this depends on building ruby itself with the --enable-shared flag + XEN_LIBS="`$PKG_CONFIG ruby-2.6 --libs`" + LOCAL_LANGUAGE=Ruby-`$PKG_CONFIG ruby-2.6 --modversion` + ac_snd_extension_language=Ruby + if test "$ac_snd_gui_choice" = gtk ; then + S7_LIB="xg.o" + else + S7_LIB="" + fi + + fi + fi + + if test "$ac_snd_extension_language" = none ; then if $PKG_CONFIG ruby-2.5 --exists ; then $as_echo "#define HAVE_RUBY 1" >>confdefs.h diff -pruN 19-1/configure.ac 19.0-1/configure.ac --- 19-1/configure.ac 2018-11-23 11:33:45.000000000 +0000 +++ 19.0-1/configure.ac 2018-12-25 11:39:13.000000000 +0000 @@ -386,7 +386,7 @@ fi if test "$with_ruby" = yes ; then if test x$PKG_CONFIG != xno ; then - m4_foreach([ruby_version], [[ruby-2.5], [ruby-2.4], [ruby-2.3], [ruby-2.2], [ruby-2.1], [ruby-2.0], [ruby], [ruby-1.9.3], [ruby-1.9], [ruby-1.8]], + m4_foreach([ruby_version], [[ruby-2.6], [ruby-2.5], [ruby-2.4], [ruby-2.3], [ruby-2.2], [ruby-2.1], [ruby-2.0], [ruby], [ruby-1.9.3], [ruby-1.9], [ruby-1.8]], [ if test "$ac_snd_extension_language" = none ; then if $PKG_CONFIG ruby_version --exists ; then diff -pruN 19-1/COPYING 19.0-1/COPYING --- 19-1/COPYING 2018-11-23 11:33:45.000000000 +0000 +++ 19.0-1/COPYING 2018-04-11 12:22:37.000000000 +0000 @@ -1,6 +1,5 @@ Snd is a sound editor written by Bill Schottstaedt (bil@ccrma.stanford.edu). -Except where otherwise noted, it is Copyright 1996-2006 The Board of Trustees -of Stanford University. +Except where otherwise noted, it is Copyright 1996-2016 Bill Schottstaedt. diff -pruN 19-1/debian/changelog 19.0-1/debian/changelog --- 19-1/debian/changelog 2018-11-26 09:12:32.000000000 +0000 +++ 19.0-1/debian/changelog 2019-01-07 19:48:50.000000000 +0000 @@ -1,3 +1,12 @@ +snd (19.0-1) unstable; urgency=medium + + * New upstream version 19.0 + * Updated upstream changelog + * Refreshed patches + * Bumped standards version to 4.3.0 + + -- IOhannes m zmölnig (Debian/GNU) Mon, 07 Jan 2019 20:48:50 +0100 + snd (19-1) unstable; urgency=medium * New upstream version 19 diff -pruN 19-1/debian/control 19.0-1/debian/control --- 19-1/debian/control 2018-11-26 09:12:32.000000000 +0000 +++ 19.0-1/debian/control 2019-01-07 19:48:50.000000000 +0000 @@ -19,7 +19,7 @@ Build-Depends: libasound2-dev [linux-any], libmpc-dev, bzip2, -Standards-Version: 4.2.1 +Standards-Version: 4.3.0 Rules-Requires-Root: no Vcs-Git: https://salsa.debian.org/multimedia-team/snd.git Vcs-Browser: https://salsa.debian.org/multimedia-team/snd diff -pruN 19-1/debian/patches/fix-spelling.patch 19.0-1/debian/patches/fix-spelling.patch --- 19-1/debian/patches/fix-spelling.patch 2018-11-26 09:12:32.000000000 +0000 +++ 19.0-1/debian/patches/fix-spelling.patch 2019-01-07 19:48:50.000000000 +0000 @@ -17,7 +17,7 @@ This patch header follows DEP-3: http:// if (ch>0 && src_data.output_frames_gen!=outlen){ --- snd.orig/s7.c +++ snd/s7.c -@@ -26517,7 +26517,7 @@ +@@ -26481,7 +26481,7 @@ s7_pointer it; it = s7_apply_function(sc, func, list_1(sc, e)); if (!is_iterator(it)) @@ -26,7 +26,7 @@ This patch header follows DEP-3: http:// return(it); } return(NULL); -@@ -88383,7 +88383,7 @@ +@@ -88530,7 +88530,7 @@ the associated clauses are evaluated, whereupon cond returns." #define and_help "(and expr expr ...) evaluates each of its arguments in order, quitting (and returning #f) \ as soon as one of them returns #f. If all are non-#f, it returns the last value." @@ -37,7 +37,7 @@ This patch header follows DEP-3: http:// match is found (via eqv?), the associated clauses are evaluated, and case returns." --- snd.orig/tools/ffitest.c +++ snd/tools/ffitest.c -@@ -1674,7 +1674,7 @@ +@@ -1663,7 +1663,7 @@ s7_pointer iter, x; iter = s7_make_iterator(sc, s7_list(sc, 3, TO_S7_INT(1), TO_S7_INT(2), TO_S7_INT(3))); if (!s7_is_iterator(iter)) diff -pruN 19-1/debian/upstream-changelog 19.0-1/debian/upstream-changelog --- 19-1/debian/upstream-changelog 2018-11-26 09:12:32.000000000 +0000 +++ 19.0-1/debian/upstream-changelog 2019-01-07 19:48:50.000000000 +0000 @@ -1,3 +1,29 @@ +Snd 19.0 + +s7: added (*s7* 'history-enabled) at Kjetil's suggestion. + deprecated s7_gc_unprotect (use s7_gc_unprotect_at). + added weak-hash-table + +The main visible s7 change: + +hash-table* is now hash-table, and the old hash-table is gone. +This code can provide backwards compatibility except for some +corner cases involving map and for-each: + +(when (string>=? (s7-version) "8.0") + (define hash-table* hash-table) + (define (hash-table . args) + (apply hash-table* (map (lambda (x) + (values (car x) (cdr x))) + args)))) + + +checked: sbcl 1.4.14|15 + +Thanks!: Kjetil Matheussen + +=============================================================================== + Snd 18.9: Kjetil updated the s7webserver directory diff -pruN 19-1/dlocsig.html 19.0-1/dlocsig.html --- 19-1/dlocsig.html 2018-11-23 11:33:45.000000000 +0000 +++ 19.0-1/dlocsig.html 1970-01-01 00:00:00.000000000 +0000 @@ -1,705 +0,0 @@ - - - - -"dlocsig" dynamic spatial location unit generator - - - - -

- -

dlocsig: a dynamic spatial location unit generator for CLM-2

- -

by Fernando Lopez-Lezcano, nando@ccrma.stanford.edu - -

dlocsig.lisp is a unit generator that dynamically moves a sound source in 2d or 3d space and can be used as a replacement for the standard locsig in new or existing CLM instruments (this is a new and much improved version of the old dlocsig).

- -

Caveat: this version of dlocsig only works in clm-3!.

- -

dlocsig can generate spatial positioning cues for any number of speakers which can be arbitrarily arranged in 2d or 3d space. There are two speaker arrangements for each possible number of speakers, one in 2d and another in 3d space. The number of output channels of the current output stream (usually defined by the :channels keyword in the enclosing with-sound) and the value of dlocsig-3d will determine which speaker arrangement is used. In pieces which can be recompiled from scratch this feature allows the composer to easily create several renditions of the same piece, each one optimized for a particular number, spatial configuration of speakers and rendering technique. Each user-defined speaker arrangement can also include fixed delays for some or all speakers and can map each speaker to an arbitrary output channel.

- -

dlocsig can render the output soundfile with different techniques. The default is to use plain vanilla amplitude panning between adyacent speakers (between two speakers in 2d space or three speaker groups in 3d space). dlocsig can also create an Ambisonics encoded four channel output soundfile suitable for feeding into an appropriate decoder for multiple speaker reproduction. Or it can decode the Ambisonics encoded information to an arbitrary number of output channels if the speaker configuration is known in advance. In the (near?) future dlocsig will also be able to render to stereo soundfiles with hrtf generated cues for heaphone or speaker listening environments. In all cases doppler shift is also generated as well as amplitude scaling due to distance with user-defined exponents and ratio of direct to reverberated sound.

- -

The movement of sound sources is described through paths. These are CLOS (Common Lisp Object System) objects that hold the information needed by dlocsig to move the source in space and are independent of the unit generator itself. Paths can be reused across many calls to dlocsig and can be translated, scaled and rotated in space as needed. There are several ways to describe a path in space. Bezier paths are described by a set of discrete points in 2d or 3d space that are latter joined by smoothly curved bezier segments. This description is very compact and easy to specify. A few points can describe a complex trajectory in 3d space. Paths can also be specified in geometric terms and one such implementation (spirals) is currently provided (more to come).

- -

The dlocsig unit generator uses the same interface as all other CLM unit generators. make-dlocsig creates a structure for a given path and returns (as multiple values) the structure and the beginning and ending samples of the note. dlocsig is the macro that gets compiled inside the run loop and localizes the samples in space.

- -

Contents

- -
-
Source code: dlocsig.lisp -
Rendering techniques -
Global parameters -
Speaker configuration -
Paths -
Bezier paths -
Geometric paths -
Transformations -
Visualization -
Dlocsig (the unit generator) -
Examples -
- -

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-Rendering techniques -
-

Several different techniques can be selected to render the output samples. Each one has advantages and disadvantages and there's no reason not to mix them in a piece. The value of the special variable dlocsig-render-using or the render-using make-dlocsig parameter defines which one is used:

- -
- -
amplitude-panning [1] -

Generates amplitude panning between adyacent speakers. In two-dimensional speaker configurations panning is done between adyacent speakers. Three-dimensional speaker configurations split space in non-overlapping triangles with vertices at the speaker positions. Panning is done within each three speaker group. Transitions between two or three speaker groups define new breakpoints in the trajectory so that the proper speakers reache zero amplitude when transitioning between groups.

- -
b-format-ambisonics [2] -

Generates a four channel first order b-format encoded soundfile (an error will be generated if the current output stream is not four channels). The Ambisonics b-format has four discrete channels with information encoded as follows:

- - - - - - -
W(* signal 0.707) (omnidirectional component)
X(* signal (cos A)(cos B))
Y(* signal (sin A)(cos B))
Z(* signal (sin B))
- -

A is the counter-clockwise angle of rotation from the front center and B is the angle of elevation above the horizontal plane. Note that our coordinate system is different. The X component is in the direction of our y axis (positive values in front of the listener) and the Y component is in the direction of our -x axis (to the left of the listener).

- -
decoded-ambisonics [3] -

The Ambisonics encoded information is decoded to an arbitrary number of speakers as defined by the currently selected speaker configuration. The decoded channels have higher amplitudes than the equivalent amplitude panning rendering, dlocsig-ambisonics-scaler is used to (approximately) equalize the amplitude. The default value is a quite arbitrary (but seems to do the trick) 0.707.

- -
stereo-hrtf [4] -

Not implemented yet...

- - -
-Global parameters -
- -

The following parameters are global bindings (special variables) that control the global behavior of dlocsig:

- -

- - - - - - - - - - - - - -
dlocsig-one-turn
[number]
360

A number that defines the units used to represent angles. By default angles are measured in degrees. Change the variable to represent one turn in the units of interest (for example, setting it to 1.0 will represent angles in turns).

dlocsig-speed-of-sound
[number]
344

A number that defines the units used to represent distances through the value of the speed of sound. The default measures distances in meters. Change the variable to represent the speed of sound in the desired units (ie: (setf dlocsig-speed-of-sound 1128) will enable you to measure all distances in feet).

- -
dlocsig-3d
[t|nil]
nil

A boolean value that defines what speaker configuration will be used for a given number of channels. Speakers can be arranged in two or three-dimensional patterns. Together with the number of channels of the current output stream dlocsig-3d is used to select a configuration.

- -
path-3d
[t|nil]
t

A boolean value that defines how bezier paths are going to be parsed.

- -
dlocsig-render-using
[num]
1

A number selected from predefined constants that defines which rendering technique will be used. The default is amplitude-panning. Currently available rendering technique constants are: amplitude-panning, b-format-ambisonics, decoded-ambisonics

- -
- -

-Speaker configuration -
- -

The following functions are used to arrange speaker configurations in 2 or 3d space. arrange-speakers creates a new configuration for a given number of speakers. The configuration includes the position of the speakers in space, optional delays for some or all speakers and a mapping from speakers to output channels. The configurations are stored in dlocsig-speaker-configs, a special variable that holds a bidimensional array. The first index of the array has dimension 2 and is used to differenciate between 2d and 3d configurations (a given number of speakers can be arranged both in 2d or 3d patterns). The second index is by default of dimension 9 and represent the number of speakers of a given configuration. set-speaker-configuration and get-speaker-configuration can be used to store and retrieve a configuration.

- -

-
arrange-speakers &optional-key -
(speakers '())
- (groups '())
- (distances '())
- (delays '())
- (map '())
-

- -

arrange-speakers returns a speaker configuration structure for a particular number of speakers and associated output channels. It defines the location of all speakers in two or three dimensional space, groups the speakers for panning purposes and optionally adds fixed delays to some speakers and maps individual speakers to output channels.

- -

- - - - - - - - - - - - - - - - - - - - -
speakers
[list]

A list that specifies the location of all speakers in space containing either: sub-lists with azimut and elevation angles (for three dimensional speaker distributions) or just numbers that represent azimut angles (for two dimensional speaker distributions).

groups
[list]

A list of lists that describes the grouping of speakers for the purposes of amplitude panning (the signal will be panned between speakers that belong to the same group). Each group can be composed of either two or three speakers and all groups for a given speaker configuration have to have the same length. This parameter can be ommited if the speakers are arranged in a two dimensional configuration (and thus have no elevation angles). Each speaker in a group is represented by an integer that is the zero based index of the speaker in the previously defined speakers list. This is the definition for a simple two dimensional grouping of four speakers:

- -

-(arrange-speakers :speakers '((-45 0)(45 0)(135 0)(225 0))
-                  :groups '((0 1)(1 2)(2 3)(3 0)))
-
- -

The elevation angles and the group information can be ommited in this case:

- -

-(arrange-speakers :speakers '(-45 45 135 225))
-
- -

This is another example where the same four speakers are rearranged in a 3d pattern:

- -

-(arrange-speakers :speakers '((1 -60 0)(1 60 0)(1 180 0)(1 0 90))
-                  :groups '((0 1 3)(1 2 3)(2 0 3)
-                            ;; floor
-                            (0 1 2)))
-
- -

All angles are measured by default in degrees, 0 degrees is right in front of the listener and angles increment clockwise. The unit used to represent angles can be changed by setting dlocsig-one-turn to the number that represents one turn in the desired unit (ie: (setf dlocsig-one-turn 1) will enable you to express all angles in fractions of a turn).

distances
[list]

A list of relative distances between the listener and all speakers. This parameter can be used to specify relative fixed delays between speakers to compensate for arrangements where not all speakers are equidistant from the listener. Distances are measured in meters by default. This example configuration will add 14.5mSeconds of delay (5 meters at 344m/s) to the two back channels of a four speaker configuration:

- -

-(arrange-speakers :speakers '(-45 45 135 225)
-                  :distances '(0 0 5 5)
-
- -

The unit used to represent distances can be changed by setting dlocsig-speed-of-sound to a number that represents the speed of sound in the desired unit (ie: (setf dlocsig-speed-of-sound 1128) will enable you to express all distances in feet). Delays can also be specified directly by using the delays keyword.

delays
[list]

A list of relative delays of all speakers. Delays are specified in seconds and must be zero or positive. A fixed delay line of the appropriate length is inserted on all channels that have a non-zero delay.

map
[list]

A list that maps the speakers to output channels. Each number of the list defines the zero-based output channel where that speaker will be sent. The following configuration of four speakers will generate a soundfile where left front and back speakers have even channel numbers and right front and back speakers have odd channel numbers:

- -

-(arrange-speakers :speakers '(-45 45 135 225)
-                  :map '(0 1 3 2)
-
- -
- -

- -
set-speaker-configuration config -

- -

set-speaker-configuration sets a speaker configuration for a particular number of output channels. The argument config must be a configuration structure created by arrange-speakers. The configuration will be stored at the appropriate index in the global configuration array depending on the number of speakers it defines. This example will store a new configuration in the slot corresponding to four output channels:

- -

-(set-speaker-configuration (arrange-speakers :speakers '(-45 45 135 225)
-                                             :map '(0 1 3 2)
-
- -

- -
get-speaker-configuration channels -

- -

get-speaker-configuration retrieves a speaker configuration definition from the global configuration array. The returned configuration will have the number of channels specified by channels and will be either two or three dimensional depending on the value of dlocsig-3d. make-dlocsig uses this function to retrieve the configuration that matches the number of channels of the enveloping with-sound.

- -
-

Paths

-
- -

Paths are used to describe the trajectory of the moving sound source in space.

- -

- -
Bezier paths
- - - - - - - -

Bezier paths are defined by a list of points in 2d or 3d space that the sound source will move through. The bezier path classes will create a curved trajectory that passes through all the specified points and is composed of bezier segments, one segment for each two points in the original description of the path.

- -

The trajectory pictured on the right was created by evaluating the following lisp code:

- -

-(make-path 
- '((-10 10 0 1)(0 5 0 0)(10 10 5 1.5)))
-
- -

All the intermediate points that create the smooth trajectory were rendered from the bezier segments fitted by make-path to the three supplied points.

-

The fourth optional parameter controls the relative velocity of the movement. In our example the sound source slows down to zero velocity on the second point and reaches the third point at 1.5 times the speed it started it.

- -

These are the corresponding graphs of average velocity, acceleration and doppler shift for each segment of the trajectory.

- -
- -

This rendition of the trajectory in terms of a smooth curve is necessary for a perceptually convincing rendition of the doppler frequency effect. A trajectory composed of straigh lines connecting the points would imply a sudden change of the velocity vector at each inflection point. Any such change in the radial velocity component will produce a sudden jump in doppler shift which will translate perceptually in a jump in pitch instead of a jump in doppler shift. This is one way in which the illusion of a moving sound source can be easily destroyed.

- -

-
make-path &optional-key -
(3d path-3d)
- (path '())
- (polar nil)
- (closed nil)
- (curvature nil)
- (error 0.01)
- (initial-direction '())
- (final-direction '())
-

- -

make-path returns a bezier path object that can be used as an argument to the make-dlocsig unit generator creation function.

- -

- - - - - - - - - - - - - - - - - - - - - -
3d
[t|nil]

Defines how the path parameter will be parsed. If t the path will be interpreted as containing points in 3d space. If nil it will be interpreted as containing 2d points. The default for 3d is defined by the path-3d special variable (normally t.

- -
path
[list]

A list that contains the points in 2d or 3d space the sound source will have to move through and the optional relative velocity of the source at each of those points. Points can be defined in cartesian (the default) or polar coordinates. To be rendered as a set of bezier segments the path description has to contain at least three points (four points if the path is closed). Paths with only two points will be rendered as a straight line. Paths with only one point define stationary sound sources.

- -

These are the recognized formats for each point if the components of path are lists and 3d is t:

- -
- -
(x y z v) -
x, y, z are the coordinates of the point, v is a relative velocity value - -
(x y z) -
x, y, z are the coordinates of the point, velocity is nil - -
(x y) -
x and y are the coordinates of the point, z is 0.0 and velocity is nil - -
- -

If 3d is nil:

- -
- -
(x y v) -
x, y are the coordinates, z is 0.0 and v is a relative velocity value - -
(x y) -
x and y are the coordinates, z is 0.0 and velocity is nil - -
- -

This will move the sound source from left to the right and up and the source's velocity will be zero right in front of the listener's position:

- -
  (make-path :path '((-10 10 0 1)(0 5 0 0)(10 10 10 1)))
- -
polar
[nil|t]

If polar is t path will be interpreted as a list of points in polar coordinates. The formats recognized are the same except the first coordinate is the distance from the source to the listener, the second is the azimut angle and the third (and optional) is the elevation angle.

- -
closed
[nil|t]

Defines a path as closed. The first and last points of a closed path have to have the same coordinates. Because of limitations in the bezier curve fitting algorithm closed paths have to have at least 4 points.

- - -
curvature
[number|list]

The curvature parameter can be used to affect the transitions between consecutive bezier segments. The default value of 1.0 does not change the fitted value of the bezier segment control points. Values above 1.0 will result in more open transitions between segments. Values below 1.0 will create faster transitions between bezier segments. curvature can be a number in which case it will affect all transitions or it can be a list with one component for each pair of points in the trajectory. In this case each component can be a number (both ends of the segment will have the same curvature) or a list with two numbers (each end of the segment can have a different curvature).

- -

The figure on the left was created by (make-path '((-10 10)(0 5)(10 10)) :curvature '(0.4 1)). The first segment of the trajectory changes direction more abruptly than the second that uses the default of 1 for the parameter. The second was created by (make-path '((-10 10)(0 5)(10 10)) :curvature 0.4), now both segments share the same curvature.

- -

- - -


:curvature '(0.4 1)


:curvature 0.4

- -
error
[number]

The bezier curves that represent the trajectory are rendered into a straight line representation. This parameter defines the maximum error allowed between the ideal bezier curve and the midpoint of each rendered linear segment.

- -

The following figures illustrate the effect of the error parameter. All figures represent the same path in 2d space '((-10 10)(0 5)(10 10)). The one on the left was created with (make-path '((-10 10)(0 5)(10 10)) :error 3). The error bound is so large that no points are actually interpolated between the three supplied points (even though internally the bezier curve control points were calculated). The one on the center was created with (make-path '((-10 10)(0 5)(10 10)) :error 0.3). Two intermediate points are calculated between each of the three supplied points. The one on the right was created with (make-path '((-10 10)(0 5)(10 10)) :error 0.01) and closely approaches the ideal bezier curve.

- -

- - - -


:error 3


:error 0.3


:error 0.01

- -
initial-direction
[list]

If the path is not closed this list defines the initial direction of the movement. The list specifies the direction as a vector expressed in x, y, z coordinates.

final-direction
[list]

If the path is not closed this list defines the final direction of the movement. The list specifies the direction as a vector expressed in x, y, z coordinates.

- -

-
make-polar-path &optional-key -
(3d path-3d)
- (path '())
- (closed nil)
- (curvature nil)
- (error 0.01)
- (initial-direction '())
- (final-direction '())
-

- -

make-polar-path returns a bezier path object that can be used as an argument to the make-dlocsig unit generator creation function. It will automatically parse the trajectory points as being represented in polar coordinates.

- -

-
make-closed-path &optional-key -
(3d path-3d)
- (path '())
- (polar nil)
- (curvature nil)
- (error 0.01)
- (initial-direction '())
- (final-direction '())
-

- -

make-polar-path returns a bezier path object that can be used as an argument to the make-dlocsig unit generator creation function. It will create a closed path.

- -

- -
Geometric paths
- -

Geometric paths are defined by a description of the path in terms of geometry. For now only one type of geometric path has been defined as an extension to 3d of the old spiral-path of the old dlocsig implementation.

- -

-
make-spiral-path &optional-key -
(start-angle 0d0)
- (total-angle nil)
- (step-angle (/ dlocsig-one-turn 100))
- (turns nil)
- (distance '(0 10 1 10))
- (height '(0 0 1 0))
- (velocity '(0 1 1 1))
-

- -

make-spiral-path returns a spiral trajectory centered around the listener's position.

- -

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
start-angle
[number]

The start angle for the spiral.

total-angle
[number]

The total angle for the spiral.

step-angle
[number]

The step angle that will be used to render the spiral. The default is 1/100 of a turn.

turns
[number]

An alternative way of specifying the total angle comprised by the spiral. Mutually exclusive with total-angle

distance
[envelope]

Distance from the source to xy = 0,0 expressed as an envelope.

height
[envelope]

Height of the source expressed as an envelope.

velocity
[envelope]

Relative velocity of the source expressed as an envelope.

- -

- -
Path transformations
- -

Not written yet...

- -

- -
Path visualization
- -

Ahem, there is no graphical path editor... yet. If your system includes the gnuplot utility you can use the following functions to graphically visualize the path and its properties.

- -

-
plot path -

- -

This will plot two views, one containing the trajectory and the other containing overlapping plots of the velocity, acceleration and doppler shift of the moving sound source.

- -

-
plot-trajectory path -

- -

Plots the trajectory of the moving sound source.

- -

-
plot-velocity path -

- -

Plots the velocity of the moving sound source.

- -

-
plot-acceleration path -

- -

Plots the acceleration of the moving sound source.

- -

-
plot-doppler path -

- -

Plots the doppler shift of the moving sound source.

- -
-

DLOCSIG

-
- -

-
make-dlocsig &optional-key
-
(start-time nil)
- (duration nil)
- (path dlocsig-path)
- (scaler dlocsig-scaler)
- (direct-power dlocsig-direct-power)
- (reverb-power dlocsig-reverb-power)
- (inside-radius dlocsig-inside-radius)
- (inside-direct-power dlocsig-inside-direct-power)
- (inside-reverb-power dlocsig-inside-reverb-power)
- (reverb-amount dlocsig-reverb-amount)
- (initial-delay dlocsig-initial-delay)
- (unity-gain-dist dlocsig-unity-gain-dist)
- (minimum-segment-size dlocsig-minimum-segment-size)
- (render-using dlocsig-render-using)
- -

- -

make-dlocsig creates a dlocsig structure that can be used as parameter to dlocsig in the Run loop. It returns three values, the first one the structure itself, the second the starting absolute sample in the output soundfile and the third the end sample in the output soundfile. A multiple-value-bind can be used to bind to all three values:

- -

-(multiple-value-bind (dloc beg end)
-    (make-dlocsig :start-time start-time
-                  :duration duration
-                  :path path)
-...
-    (run
-      (loop for i from beg below end do
-        (dlocsig dloc i sample)))
-
- -

All default values are asigned to special variables named dlocsig-xxx, where xxx stands for the name of the parameter. This enables calls to the instrument to be surrounded by let statements so that local bindings can be established for default parameters. In the following example the first two notes are rendered using amplitude panning between speakers (if the default has not been changed before) and the second two are rendered using ambisonics because they are within the enclosing let that rebinds the special variable dlocsig-render-using:

- -

-(with-sound(:channels 8)
-  (some-instrument 0 1 440 0.1)
-  (another-instrument 2.33 0.4 880 0.18)
-  (let* ((dlocsig-render-using decoded-ambisonics))
-    (some-instrument 2 2.5 1000 0.07)
-    (some-instrument 4 2.2 1002 0.05)))
-
- - - -
-
Required parameters -
start-time, duration, path -
Optional parameters -
scaler, direct-power, reverb-power, inside-radius, inside-direct-power, inside-reverb-power, reverb-amount, initial-delay, unity-gain-distance, minimum-segment-size, render-using -
-
- -

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
start-time
[num]
Start time of the note in the output soundfile.

duration
[num]

Duration of the note. Actually this is not going to be the real duration of the note. This is the duration of the note at the moving source's position. Depending on the net change of distance from the source to the listener the actual duration of the note can be shorter (ending distance is less than starting distance) or longer (ending distance longer than starting distance). The doppler effect due to radial movement of the source translates into a sample rate change of the source which directly leads to the change in duration. The actual duration of the note is returned (indirectly) through the second and third values returned by make-dlocsig. Those numbers (absolute starting and ending samples of the note) should be used to control the main iteration loop inside the run macro.

path
[path]

A path object that describes the movement of the sound source in space.

scaler -
[num]
1.0

Overall amplitude scaler. This number scales the gain envelopes for all output and reverb channels.

direct-power -
[num]
1.5

The amplitude of the sound normally decreases as (/ dist) where dist is the distance between the source and the listener. This number can alter the exponent of the denominator so that the law of change becomes (/ (expt dist direct-power). Positive numbers will make the attenuation with distance increase faster than what would be normal.

reverb-power -
[num]
0.5

Defines how the amplitude of the signal sent to the reverberator output channels changes in amplitude with distance.

inside-radius -
[num]
1.0

Rendering cues are calculated differently when the sound source is inside the sphere delimited by inside-radius (ie: when the sound is somehow "inside" the head of the listener). The exact difference depends on the rendering method used but the general idea is that within that sphere all speakers emit signal which is proportional to the distance to the center of the sphere (the listener's position).

inside-direct-power -
[num]
1.5

Within the sphere delimited by inside-radius and when rendering to amplitude panning all speakers output signal proportional to the distance to the listeners position.

inside-reverb-power -
[num]
0.5

This number controls the exponent of the attenuation curve for the revererated sound when inside the sphere delimited by inside-radius.

reverb-amount -
[num|env]
0.04
How much signal is sent to the reverberator output channel. Can be a number or an envelope.

initial-delay -
[t|nil]
nil

If set to nil the minumum time delay between the source and the listener is substracted from the delay line. This will reduce but not necessarily eliminate the initial delay from the start of the note at the position of the source and the arrival of the sound at the listener's position.

unity-gain-distance -
[t|nil|num]
nil

If a number is specified it represents the distance at which dlocsig processes the samples with unity gain. If set to nil the minimum distance between source and listener is used as the unity gain distance. If set to t no amplitude normalization is done and the attenuation will accurately represent the object's distance.

minimum-segment-size -
[num]
1.0

Defines the minimum distance between segment breakpoints. If a segment is longer than this distance it is split into smaller segments until the condition is satisfied. Otherwise long segments would not properly render the attenuation versus distance curve (ie: it would be just a linear curve instead of the specified power curve).

render-using -
[num]
1

Defines the rendering technique used to generate the output samples. Acceptable values are the following predefined constants: amplitude-panning (1) for speaker group amplitude panning, b-format-ambisonics (2) for four channel ambisonics encoded output and decoded-ambisonics (3) for a multichannel decoding of the ambisonics components.

- -

-
dlocsig dloc i sample -

- -

Localizes a sample and merges it into the output file at absolute sample number i.

- -

- - - - - - - - - - -
dloc
[dlocs]
dlocsig structure created with make-dlocsig.

i
[integer]

Absolute sample number in the output soundfile, normally the loop counter of the run loop.

sample
[sample]

The sample to be localized.

- -

-

Examples

-
- -

This is a very simple instrument that dynamically moves a sine wave in space using dlocsig:

- -

-(definstrument sinewave (start-time duration freq amp 
-		         &key
-			 (amp-env '(0 1 1 1))
-			 (path (make-path :path '(-10 10 0 5 10 10))))
-  (multiple-value-bind (dloc beg end)
-      (make-dlocsig :start-time start-time
-		    :duration duration
-		    :path path)
-    (let* ((osc (make-oscil :frequency freq))
-	   (aenv (make-env :envelope amp-env :scaler amp)))
-      (run
-       (loop for i from beg below end do
-	 (dlocsig dloc i (* (env aenv)(oscil osc))))))))
-
- -

Note how the starting and ending samples of the main loop in the run macro are provided by the second and third values returned by make-dlocsig. Other than that this a very simple example. This instrument can be called as follows (in a four channel environment):

- -

-(with-sound(:channels 4)
-  (sinetest 0 1 440 0.5 :path (make-path '((-10 10)(0 5)(10 10)))))
-
- -

This will select the default 2d speaker configuration for four channels (if the default value of dlocsig-3d is not changed to t). The same instrument could be used to render a 3d soundfile for eight channels by calling it with the following parameters:

- -

-;; tell the system I want to use the 3d speaker configuration
-(setf dlocsig-3d t)
-;; render the sound with a 3d path
-(with-sound(:channels 8)
-  (sinetest 0 1 440 0.5 :path (make-path '((-10 10 0)(0 5 10)(10 10 5)))))
-
- -

Existing instruments can be easily converted to use dlocsig:

- -
    -
  • add parameters to the definstrument definition. You will need at least one additional parameter to supply the path. -
  • replace the calculation of the run loop begin and end samples with the second and third values that are returned by make-dlocsig. Use a multiple-value-bind to get them (see the example above) instead of basing the calculation solely on the starting time and duration of the note (which must be supplied to make-dlocsig). -
  • replace the current output code with a call to dlocsig. Look for either the standard locsig or outa. -
- -

dlocsig assumes it receives time-ordered samples from the instrument. It will not work in instruments like grani, a granular synthesis instrument that can randomly splatter samples all over the duration of the note. It will also not work in instruments that generate more than one output channel (ie: dlocsig needs a mono source). In those cases you can use a second instrument which contains dlocsig and a sound-let to hold the rendered sound until it is spatialized. This solution can also be used to spatialize arbitrary instruments when you want to avoid modifying the instrument code (of course, at the expense of having to create the temporary soundfile). Obviously you can also modify your multichannel instrument to use an array of dlocsig structures and spatialize each channel independently!.

- -

Take a look at the move-sound.ins example instrument. The file includes an instrument (move) that can spatialize multichannel soundfiles and a macro (move-it) that can wrap arbitrary lisp code and will spatialize the resulting soundfile. Before trying the example compile and load dlocsig, move-it and Bill's fm-violin:

- -

-(with-sound(:channels 4 :play nil)
-  (move-it (:path (make-path '((-10 10)(0.1 0.1)(10 -10))))
-    (fm-violin 0 1 440 0.1)
-    (fm-violin 0.3 2 1020 0.05)))
-
- -

The preceding code fragment will create a temporary soundfile with the output of the two fm-violin notes and then will spatialize it using the supplied path. The body of the macro could be made to generate a multichannel soundfile in which case you would have to supply as many paths as channels are generated (each channel is independently spatialized). This rather pointless example illustrates this. The first call to fm-violin outputs to the left channel of the temporary file and the second to the right channel:

- -

-(with-sound(:channels 4 :play nil)
-  (move-it (:channels 2 
-            :paths (list (make-path '((-10 10)(0.1 0.1)(10 -10)))
-                         (make-spiral-path :turns 2)))
-    (fm-violin 0 1 440 0.1 :degree 0)
-    (fm-violin 0.3 2 1020 0.05 :degree 90)))
-
- -

- -

-History
- -

The original "dlocsig" was born in 1992 while I was working at Keio University in Japan. It was originally written to create localization cues for a four channel environment, the hardware being the QuadBox, a four channel D/A that attached to the DSP port of a NeXT computer. The hardware was originally built by Atau Tanaka at CCRMA while I worked on the software in Japan (mainly a 56K DSP program to play four channel soundfiles on the NeXT and an accompaining c code player - quadplay).

- -

Thanks to Juan Pampin for prodding me to write this second version and for his help in the first stages of the project.

- -
- -
- ©1999, 2000, 2001 Fernando Lopez-Lezcano. All Rights Reserved.
- Created and mantained by Fernando Lopez-Lezcano, - nando@ccrma.stanford.edu

-

- - - diff -pruN 19-1/expr.scm 19.0-1/expr.scm --- 19-1/expr.scm 2018-11-23 11:33:45.000000000 +0000 +++ 19.0-1/expr.scm 1970-01-01 00:00:00.000000000 +0000 @@ -1,272 +0,0 @@ -(define* (linear-expr-1D data (generations 100)) - - (let ((size 100) - (range 1.0) - (data-size (length data))) - - (let ((population (make-vector size))) - - (define (initial-generation) - (do ((i 0 (+ i 1))) - ((= i size)) - (set! (population i) (vector (- (random range) (/ range 2)) (- (random range) (/ range 2)))))) - - - (define (distance coeff offset) - (let ((dist 0.0)) - (do ((k 0 (+ k 1))) - ((= k data-size) dist) - (let ((err (- (data k) (+ (* coeff k) offset)))) - (set! dist (+ dist (* err err))))))) - - - (define (next-generation) - (let ((distances (make-vector size 0.0))) - (do ((i 0 (+ i 1))) - ((= i size)) - (set! (distances i) (cons (distance ((population i) 0) ((population i) 1)) i))) - (sort! distances (lambda (a b) (< (car a) (car b)))) - (do ((i (/ size 2) (+ i 1)) - (j 0 (+ j 1))) - ((= i size)) - (let* ((loc (cdr (distances j))) ; location (in population) of a good one - (coeff ((population loc) 0)) ; its coeff - (offset ((population loc) 1)) ; and offset - (new-loc (cdr (distances i)))) ; location of the bad one - ;(format #t "~D: replace ~A using ~A~%" j (distances i) (distances j)) - (set! (population new-loc) (vector (+ coeff (- (random range) (/ range 2))) - (+ offset (- (random range) (/ range 2))))))) - (distances 0))) - - - (initial-generation) - (let ((last-dist size) - (best #f)) - (call-with-exit - (lambda (done) - (do ((i 0 (+ i 1))) - ((= i generations)) - (set! best (next-generation)) - ;(format #t "~D: ~A ~A ~A~%" i range (car best) (population (cdr best))) - (if (< (car best) 1e-9) - (done)) - (let* ((new-dist (car best)) - (improvement (abs (- new-dist last-dist)))) - (if (< improvement range) - (set! range (max 0.001 (* range 0.5))) - (if (> improvement range) - (set! range (min 1024.0 (* 2 range))))) - (set! last-dist new-dist))))) - - (let ((simpler-coeff (rationalize ((population (cdr best)) 0) .1)) - (simpler-offset (rationalize ((population (cdr best)) 1) .1))) - (let ((dist (distance simpler-coeff simpler-offset))) - (if (< dist (* 2 (car best))) - (format #f "~A * k + ~A, err: ~A~%" simpler-coeff simpler-offset dist) - (format #f "~A * k + ~A, err: ~A~%" ((population (cdr best)) 0) ((population (cdr best)) 1) (car best))))))))) - - - -#| -(linear-expr-1D (let ((v (make-vector 100))) - (do ((i 0 (+ i 1))) - ((= i 100)) - (set! (v i) (+ 1 (* i 2))) ) - v)) -"2 * k + 1, err: 0.0" - -(linear-expr-1D (let ((v (make-vector 100))) - (do ((i 0 (+ i 1))) - ((= i 100)) - (set! (v i) (+ 1 (- (random .01) .005) (* i 2)))) - v)) -"2 * k + 1, err: 0.00079150685524436" -;; so noise is not a problem - -|# - -(define *show-progress* #f) - -(define* (poly-expr data (generations 100) (top-power 10) (xscale 1.0)) - - (let ((size 100) - (range 1.0) - (data-size (length data))) - - (let ((population (make-vector size))) - - (define (new-coeffs good-coeffs bad-coeffs power) - (let* ((len (length good-coeffs)) - (coeffs (make-vector len 0.0))) - (do ((k 0 (+ k 1))) - ((> k power) coeffs) - (let ((local-diff (/ (- (good-coeffs k) (bad-coeffs k)) 2.0))) - (set! (coeffs k) (+ (good-coeffs k) local-diff (- (random range) (/ range 2)))))))) - - (define (initial-generation power) - (let ((len (+ 1 power))) - (do ((i 0 (+ i 1))) - ((= i size)) - (set! (population i) (new-coeffs (make-vector len 0.0) (make-vector len 0.0) power))))) - - (define (poly coeffs x power) - ;; 0 => offset, 1 => x, 2 => x^2 etc - (if (= power 1) - (+ (coeffs 0) (* (coeffs 1) x)) - (let ((sum (coeffs power))) - (do ((k (- power 1) (- k 1))) - ((< k 0) sum) - (set! sum (+ (coeffs k) (* x sum))))))) - - (define (distance coeffs power) - (let ((dist 0.0)) - (do ((k 0 (+ k 1))) - ((= k data-size) dist) - (let ((err (- (data k) (poly coeffs (* xscale k) power)))) - (set! dist (+ dist (* err err))))))) - - (define (iterate-distance coeffs power) - ;; distance if using iterated function, rather than just polynomial - (call-with-exit - (lambda (return) - (let* ((dist 0.0) - (y 0.0)) - (do ((k 0 (+ k 1))) - ((= k data-size) dist) - (let ((err (modulo (- (data k) y) 2.0))) - (if (nan? err) ; modulo returns NaN if either arg is inf - (return 1.0e50)) - (if (> err 1.0) - (set! err (- 2.0 err))) - (set! dist (+ dist (* err err))) - (set! y (poly coeffs y power)))))))) - - (define (display-expr coeffs power) - (do ((k power (- k 1))) - ((= k 1)) - (format #t "~,3g k^~D + " (coeffs k) k)) - (format #t "~,3g k + ~,3g" (coeffs 1) (coeffs 0))) - - (define (next-generation power) - (let ((distances (make-vector size 0.0))) - (do ((i 0 (+ i 1))) - ((= i size)) - (set! (distances i) (cons (distance (population i) power) i))) - (sort! distances (lambda (a b) (< (car a) (car b)))) - (do ((i (/ size 2) (+ i 1)) - (j 0 (+ j 1))) - ((= i size)) - (let* ((good-loc (cdr (distances j))) ; location (in population) of a good one - (good-coeffs (population good-loc)) ; its coeffs - (bad-loc (cdr (distances i))) ; location of the bad one - (bad-coeffs (population bad-loc))) ; its coeffs - (set! (population bad-loc) (new-coeffs good-coeffs bad-coeffs power)))) - (distances 0))) - - (do ((power 1 (+ power 1))) - ((> power top-power)) - - (initial-generation power) - (let ((last-dist size) - (best #f)) - (call-with-exit - (lambda (done) - (do ((i 0 (+ i 1))) - ((= i generations)) - (let ((new-best (next-generation power))) - (if (and *show-progress* - best - (< (car new-best) (car best))) - (begin - (format #t " ") - (display-expr (population (cdr new-best)) power) - (format #t ", err: ~,3g~%" (car new-best)))) - (set! best new-best)) - (if (< (car best) 1e-9) - (done)) - (let* ((new-dist (car best)) - (improvement (abs (- new-dist last-dist)))) - (if (< improvement range) - (set! range (max 0.001 (* range 0.5))) - (if (> improvement range) - (set! range (min 1024.0 (* 2 range))))) - (set! last-dist new-dist))))) - - (let ((simpler-coeffs (apply vector (map (lambda (x) (rationalize x .1)) (population (cdr best)))))) - (let ((dist (distance simpler-coeffs power))) - (if (< dist (* 2 (car best))) - (begin - (display-expr simpler-coeffs power) - (format #t ", err: ~,3g~%~%" dist)) - (begin - (display-expr (population (cdr best)) power) - (format #t ", err: ~,3g~%~%" (car best))))))))))) - -#| -:(poly-expr (let ((v (make-vector 100))) - (do ((i 0 (+ i 1))) - ((= i 100)) - (set! (v i) (+ 1.5 (* i 2)))) - v) - 100 2) -() -2 * k + 3/2, err: 0.0 - -0 * k^2 + 2 * k + 3/2, err: 0.0 - - -:(poly-expr (let ((v (make-vector 100))) - (do ((i 0 (+ i 1))) - ((= i 100)) - (set! (v i) (+ 1.5 (* i 2) (* i i)))) - v) - 100 2) -() -101 * k + -3231/2, err: 55527780.0 - -1 * k^2 + 2 * k + 3/2, err: 0.0 - - -(poly-expr (let ((v (make-vector 100))) - (do ((i 0 (+ i 1))) - ((= i 100)) - (set! (v i) (+ 10 (* i 3) (* i i) (* 2 i i i)))) - v) - 500 3) - -71211/4 * k + -775493/2, err: 5073746188744.4 - -298 * k^2 + -46797/4 * k + 282358/3, err: 142657213706.32 - -1.9999646468097 * k^3 + 1.0060760943148 * k^2 + 2.7343239562578 * k + 10.395190849075, err: 341.7343511583 - - -(poly-expr (let ((v (make-vector 100))) - (do ((i 0 (+ i 1))) - ((= i 100)) - (set! (v i) (+ 10 (* i 3) (* i i) (* .02 i i i)))) - v) - 500 3) - -279 * k + -16405/3, err: 889433525.53111 - -4 * k^2 + -114 * k + 4756/5, err: 16055636.02 - -0.01993019520734 * k^3 + 1.0122316382516 * k^2 + 2.423061574187 * k + 16.287894409628, err: 451.01103769494 - -if scaled by .01: - -(poly-expr (let ((v (make-vector 100))) - (do ((i 0 (+ i 1))) - ((= i 100)) - (set! (v i) (+ 1.0 (* i 32 .01) (* i i 3 .01 .01) (* 1 i i i .01 .01 .01)))) - v) - 500 3 .01) - -179/5 k + 1/3, err: 11.3 - -4.48 k^2 + 31.4 k + 1.05, err: 0.0357 - -1 k^3 + 3 k^2 + 32 k + 1, err: 4.76e-28 - -|# diff -pruN 19-1/freeverb-readme.txt 19.0-1/freeverb-readme.txt --- 19-1/freeverb-readme.txt 2018-11-23 11:33:45.000000000 +0000 +++ 19.0-1/freeverb-readme.txt 1970-01-01 00:00:00.000000000 +0000 @@ -1,67 +0,0 @@ -Freeverb - Free, studio-quality reverb SOURCE CODE in the public domain ------------------------------------------------------------------------ - -Written by Jezar at Dreampoint - http://www.dreampoint.co.uk - - -Introduction ------------- - -Hello. - -I'll try to keep this "readme" reasonably small. There are few things in the world that I hate more than long "readme" files. Except "coding conventions" - but more on that later... - -In this zip file you will find two folders of C++ source code: - -"Components" - Contains files that should clean-compile ON ANY TYPE OF COMPUTER OR SYSTEM WHATSOEVER. It should not be necessary to make ANY changes to these files to get them to compile, except to make up for inadequacies of certain compilers. These files create three classes - a comb filter, an allpass filter, and a reverb model made up of a number of instances of the filters, with some features to control the filters at a macro level. You will need to link these classes into another program that interfaces with them. The files in the components drawer are completely independant, and can be built without dependancies on anything else. Because of the simple interface, it should be possible to interface these files to any system - VST, DirectX, anything - without changing them AT ALL. - -"FreeverbVST" - Contains a Steinberg VST implementation of this version of Freeverb, using the components in (surprise) the components folder. It was built on a PC but may compile properly for the Macintosh with no problems. I don't know - I don't have a Macintosh. If you've figured out how to compile the examples in the Steinberg VST Development Kit, then you should easilly figure out how to bring the files into a project and get it working in a few minutes. It should be very simple. - -Note that this version of Freeverb doesn't contain predelay, or any EQ. I thought that might make it difficult to understand the "reverb" part of the code. Once you figure out how Freeverb works, you should find it trivial to add such features with little CPU overhead. - -Also, the code in this version of Freeverb has been optimised. This has changed the sound *slightly*, but not significantly compared to how much processing power it saves. - -Finally, note that there is also a built copy of this version of Freeverb called "Freeverb3.dll" - this is a VST plugin for the PC. If you want a version for the Mac or anything else, then you'll need to build it yourself from the code. - - -Technical Explanation ---------------------- - -Freeverb is a simple implementation of the standard Schroeder/Moorer reverb model. I guess the only reason why it sounds better than other reverbs, is simply because I spent a long while doing listening tests in order to create the values found in "tuning.h". It uses 8 comb filters on both the left and right channels), and you might possibly be able to get away with less if CPU power is a serious constraint for you. It then feeds the result of the reverb through 4 allpass filters on both the left and right channels. These "smooth" the sound. Adding more than four allpasses doesn't seem to add anything significant to the sound, and if you use less, the sound gets a bit "grainy". The filters on the right channel are slightly detuned compared to the left channel in order to create a stereo effect. - -Hopefully, you should find the code in the components drawer a model of brevity and clarity. Notice that I don't use any "coding conventions". Personally, I think that coding conventions suck. They are meant to make the code "clearer", but they inevitably do the complete opposite, making the code completely unfathomable. Anyone whose done Windows programming with its - frankly stupid - "Hungarian notation" will know exactly what I mean. Coding conventions typically promote issues that are irrelevant up to the status of appearing supremely important. It may have helped back people in the days when compilers where somewhat feeble in their type-safety, but not in the new millenium with advanced C++ compilers. - -Imagine if we rewrote the English language to conform to coding conventions. After all, The arguments should be just as valid for the English language as they are for a computer language. For example, we could put a lower-case "n" in front of every noun, a lower-case "p" in front of a persons name, a lower-case "v" in front of every verb, and a lower-case "a" in front of every adjective. Can you imagine what the English language would look like? All in the name of "clarity". It's just as stupid to do this for computer code as it would be to do it for the English language. I hope that the code for Freeverb in the components drawer demonstrates this, and helps start a movement back towards sanity in coding practices. - - -Background ----------- - -Why is the Freeverb code now public domain? Simple. I only intended to create Freeverb to provide me and my friends with studio-quality reverb for free. I never intended to make any money out of it. However, I simply do not have the time to develop it any further. I'm working on a "concept album" at the moment, and I'll never finish it if I spend any more time programming. - -In any case, I make more far money as a contract programmer - making Mobile Internet products - than I ever could writing plugins, so it simply doesn't make financial sense for me to spend any more time on it. - -Rather than give Freeverb to any particular individual or organisation to profit from it, I've decided to give it away to the internet community at large, so that quality, FREE (or at the very least, low-cost) reverbs can be developed for all platforms. - -Feel free to use the source code for Freeverb in any of your own products, whether they are also available for free, or even if they are commercial - I really don't mind. You may do with the code whatever you wish. If you use it in a product (whether commercial or not), it would be very nice of you, if you were to send me a copy of your product - although I appreciate that this isn't always possible in all circumstances. - -HOWEVER, please don't bug me with questions about how to use this code. I gave away Freeverb because I don't have time to maintain it. That means I *certainly* don't have time to answer questions about the source code, so please don't email questions to me. I *will* ignore them. If you can't figure the code for Freeverb out - then find somebody who can. I hope that either way, you enjoy experimenting with it. - - -Disclaimer ----------- - -This software and source code is given away for free, without any warranties of any kind. It has been given away to the internet community as a free gift, so please treat it in the same spirit. - - -I hope this code is useful and interesting to you all! -I hope you have lots of fun experimenting with it and make good products! - -Very best regards, -Jezar. -Technology Consultant -Dreampoint Design and Engineering -http://www.dreampoint.co.uk - - -//ends diff -pruN 19-1/funcs.scm 19.0-1/funcs.scm --- 19-1/funcs.scm 1970-01-01 00:00:00.000000000 +0000 +++ 19.0-1/funcs.scm 2018-04-11 12:22:36.000000000 +0000 @@ -0,0 +1,47 @@ +(define-envelope pna '(0 0 1 1 10 .6000 25 .3000 100 0 )) +(define-envelope ind2 '(0 1 25 .4000 75 .6000 100 0 )) +(define-envelope high_att_ind '(0 1 25 .2000 75 .4000 100 0 )) +(define-envelope no_att_ind '(0 .6000 75 .6000 100 0 )) +(define-envelope no_dec_ind '(0 1 25 .4000 75 .6000 100 .6000 )) +(define-envelope no_att_or_dec_ind '(0 .6000 100 .6000 )) +(define-envelope ampf '(0 0 25 1 60 .7000 75 1 100 0 )) +(define-envelope rampf '(0 0 100 1 )) +(define-envelope fast_up '(0 0 25 1 100 1 )) +(define-envelope slow_up '(0 0 25 0 100 1 )) +(define-envelope tapf '(0 0 1 1 99 1 100 0 )) +(define-envelope skwfrq '(0 -1 5 .2500 10 0 100 .1000 )) +(define-envelope oldpizzf '(0 0 1 1 5 .6000 10 .3000 25 .1000 100 0 )) +(define-envelope newpizzf '(0 0 1 1 5 .6000 10 .3000 25 .1000 99 .0200 100 0 )) +(define-envelope pizzf '(0 0 1 1 5 .6000 10 .3000 25 .1000 100 0 )) +(define-envelope legatof '(0 0 30 1 90 1 100 0 )) +(define-envelope marcatof '(0 0 3 1 10 .8000 95 1 100 0 )) +(define-envelope onef '(0 1 100 1 )) +(define-envelope mod_up '(0 0 25 0 75 1 100 1 )) +(define-envelope mod_down '(0 1 25 1 75 0 100 0 )) +(define-envelope one_to_zero '(0 1 75 1 100 0 )) +(define-envelope zero_to_one '(0 0 75 0 100 1 )) +(define-envelope down_flat '(0 1 25 0 75 .0500 100 0 )) +(define-envelope down_down '(0 1 25 0 75 .0500 100 -1 )) +(define-envelope down_up '(0 1 25 0 75 .0500 100 1 )) +(define-envelope flat_down '(0 -.1000 10 .1000 25 0 75 .0500 100 -1 )) +(define-envelope flat_up '(0 -.1000 10 .1000 25 0 75 0 100 1 )) +(define-envelope up_flat '(0 -1 25 .0500 75 0 100 0 )) +(define-envelope up_up '(0 -1 25 .0500 75 0 100 1 )) +(define-envelope up_down '(0 -1 25 .0500 75 0 100 -1 )) +(define-envelope swellf '(0 0 25 .8000 50 1 75 .8000 100 0 )) +(define-envelope fpf '(0 0 25 1 50 .3000 75 .3000 100 0 )) +(define-envelope indswell '(1 1 25 .4000 75 1 100 0 )) +(define-envelope pyr '(0 1 25 .1000 95 .1000 100 0 )) +(define-envelope fbell '(0 1 2 1.1000 25 .7500 75 .5000 100 .2000 )) +(define-envelope lowbell '(0 1 5 1.2500 25 .8000 75 .5000 100 .2000 )) +(define-envelope abell '(0 0 .1000 1 10 .6000 25 .3000 50 .1500 90 .1000 100 0 )) +(define-envelope dwnup '(0 1 10 .4000 20 1 35 .3000 45 .8000 60 .2000 80 .6000 100 0 )) +(define-envelope up50down '(0 0 50 1 100 0 )) +(define-envelope metalamp '(0 0 .5000 1 5 1 10 .5000 15 .2500 35 .1000 100 0 )) +(define-envelope slowupfastdown '(0 0 25 1 97 1 100 0 )) +(define-envelope slowup '(0 0 50 .1000 95 1 100 0 )) +(define-envelope indtoone '(0 1 25 .4000 100 .6500 )) + +(define-envelope whoosh '(0 0 75 .1000 90 .3000 97 .6000 100 1 )) +(define-envelope mamp '(0 0 50 1 100 0 )) +(define-envelope n_amp '(0 0 65 1 100 0 )) diff -pruN 19-1/gl.c 19.0-1/gl.c --- 19-1/gl.c 2018-11-23 11:33:45.000000000 +0000 +++ 19.0-1/gl.c 2018-10-29 15:32:26.000000000 +0000 @@ -4455,9 +4455,9 @@ static void define_functions(void) { #if HAVE_SCHEME static s7_pointer s_boolean, s_integer, s_real, s_any; -static s7_pointer pl_i, pl_prrrt, pl_prrrrtttrrt, pl_iiiiiit, pl_iiiiitiiit, pl_iiiiiiiit, pl_iiiiiiiiiiit, pl_iiiiiiit, pl_iiiiiiiiiit, pl_iiiiiiiiit, pl_bi, pl_bit, pl_t, pl_tiirrrrt, pl_tiiiiiiit, pl_tiiiiiiiit, pl_tirriirriit, pl_tiiiiiiiiit, pl_tiiiiiiiiiit, pl_tiiiiiit, pl_ti, pl_tir, pl_tit, pl_tiit, pl_tiir, pl_tiib, pl_tiiit, pl_tiiib, pl_tiiiit, pl_tirrir, pl_tibiit, pl_tirriit, pl_tiiiiit, pl_tb, pl_bt, pl_tr, pl_trrrrt, pl_pit, pl_ttr, pl_ttb, pl_tti, pl_ttri, pl_ttit, pl_ttir, pl_piit, pl_piiit, pl_ttiti, pl_ttrri, pl_ttrrri, pl_ttrriir, pl_ttititi, pl_ttititiiti; +static s7_pointer pl_tr, pl_prrrt, pl_trrrrt, pl_prrrrtttrrt, pl_i, pl_t, pl_tb, pl_bi, pl_bt, pl_bit, pl_ti, pl_pit, pl_tir, pl_tit, pl_ttr, pl_ttb, pl_tti, pl_tiit, pl_ttri, pl_ttit, pl_ttir, pl_tiir, pl_piit, pl_tiib, pl_tiiit, pl_piiit, pl_tiiib, pl_ttiti, pl_ttrri, pl_tiiiit, pl_tirrir, pl_ttrrri, pl_tibiit, pl_tirriit, pl_ttrriir, pl_ttititi, pl_iiiiiit, pl_tiiiiit, pl_tiirrrrt, pl_tiiiiiiit, pl_tiiiiiiiit, pl_tirriirriit, pl_tiiiiiiiiit, pl_tiiiiiiiiiit, pl_iiiiitiiit, pl_ttititiiti, pl_iiiiiiiit, pl_iiiiiiiiiiit, pl_iiiiiiit, pl_iiiiiiiiiit, pl_iiiiiiiiit, pl_tiiiiiit; #if USE_MOTIF -static s7_pointer pl_pt, pl_pttit, pl_tttti, pl_ttttb; +static s7_pointer pl_pt, pl_tttti, pl_ttttb, pl_pttit; #endif s_boolean = s7_make_symbol(s7, "boolean?"); @@ -4465,64 +4465,64 @@ static s7_pointer pl_pt, pl_pttit, pl_tt s_real = s7_make_symbol(s7, "real?"); s_any = s7_t(s7); - pl_i = s7_make_circular_signature(s7, 0, 1, s_integer); + pl_tr = s7_make_circular_signature(s7, 1, 2, s_any, s_real); pl_prrrt = s7_make_circular_signature(s7, 4, 5, s_any, s_real, s_real, s_real, s_any); + pl_trrrrt = s7_make_circular_signature(s7, 5, 6, s_any, s_real, s_real, s_real, s_real, s_any); pl_prrrrtttrrt = s7_make_circular_signature(s7, 10, 11, s_any, s_real, s_real, s_real, s_real, s_any, s_any, s_any, s_real, s_real, s_any); - pl_iiiiiit = s7_make_circular_signature(s7, 6, 7, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); - pl_iiiiitiiit = s7_make_circular_signature(s7, 9, 10, s_integer, s_integer, s_integer, s_integer, s_integer, s_any, s_integer, s_integer, s_integer, s_any); - pl_iiiiiiiit = s7_make_circular_signature(s7, 8, 9, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); - pl_iiiiiiiiiiit = s7_make_circular_signature(s7, 11, 12, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); - pl_iiiiiiit = s7_make_circular_signature(s7, 7, 8, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); - pl_iiiiiiiiiit = s7_make_circular_signature(s7, 10, 11, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); - pl_iiiiiiiiit = s7_make_circular_signature(s7, 9, 10, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); + pl_i = s7_make_circular_signature(s7, 0, 1, s_integer); + pl_t = s7_make_circular_signature(s7, 0, 1, s_any); + pl_tb = s7_make_circular_signature(s7, 1, 2, s_any, s_boolean); pl_bi = s7_make_circular_signature(s7, 1, 2, s_boolean, s_integer); + pl_bt = s7_make_circular_signature(s7, 1, 2, s_boolean, s_any); pl_bit = s7_make_circular_signature(s7, 2, 3, s_boolean, s_integer, s_any); - pl_t = s7_make_circular_signature(s7, 0, 1, s_any); - pl_tiirrrrt = s7_make_circular_signature(s7, 7, 8, s_any, s_integer, s_integer, s_real, s_real, s_real, s_real, s_any); - pl_tiiiiiiit = s7_make_circular_signature(s7, 8, 9, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); - pl_tiiiiiiiit = s7_make_circular_signature(s7, 9, 10, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); - pl_tirriirriit = s7_make_circular_signature(s7, 10, 11, s_any, s_integer, s_real, s_real, s_integer, s_integer, s_real, s_real, s_integer, s_integer, s_any); - pl_tiiiiiiiiit = s7_make_circular_signature(s7, 10, 11, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); - pl_tiiiiiiiiiit = s7_make_circular_signature(s7, 11, 12, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); - pl_tiiiiiit = s7_make_circular_signature(s7, 7, 8, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); pl_ti = s7_make_circular_signature(s7, 1, 2, s_any, s_integer); + pl_pit = s7_make_circular_signature(s7, 2, 3, s_any, s_integer, s_any); pl_tir = s7_make_circular_signature(s7, 2, 3, s_any, s_integer, s_real); pl_tit = s7_make_circular_signature(s7, 2, 3, s_any, s_integer, s_any); - pl_tiit = s7_make_circular_signature(s7, 3, 4, s_any, s_integer, s_integer, s_any); - pl_tiir = s7_make_circular_signature(s7, 3, 4, s_any, s_integer, s_integer, s_real); - pl_tiib = s7_make_circular_signature(s7, 3, 4, s_any, s_integer, s_integer, s_boolean); - pl_tiiit = s7_make_circular_signature(s7, 4, 5, s_any, s_integer, s_integer, s_integer, s_any); - pl_tiiib = s7_make_circular_signature(s7, 4, 5, s_any, s_integer, s_integer, s_integer, s_boolean); - pl_tiiiit = s7_make_circular_signature(s7, 5, 6, s_any, s_integer, s_integer, s_integer, s_integer, s_any); - pl_tirrir = s7_make_circular_signature(s7, 5, 6, s_any, s_integer, s_real, s_real, s_integer, s_real); - pl_tibiit = s7_make_circular_signature(s7, 5, 6, s_any, s_integer, s_boolean, s_integer, s_integer, s_any); - pl_tirriit = s7_make_circular_signature(s7, 6, 7, s_any, s_integer, s_real, s_real, s_integer, s_integer, s_any); - pl_tiiiiit = s7_make_circular_signature(s7, 6, 7, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); - pl_tb = s7_make_circular_signature(s7, 1, 2, s_any, s_boolean); - pl_bt = s7_make_circular_signature(s7, 1, 2, s_boolean, s_any); - pl_tr = s7_make_circular_signature(s7, 1, 2, s_any, s_real); - pl_trrrrt = s7_make_circular_signature(s7, 5, 6, s_any, s_real, s_real, s_real, s_real, s_any); - pl_pit = s7_make_circular_signature(s7, 2, 3, s_any, s_integer, s_any); pl_ttr = s7_make_circular_signature(s7, 2, 3, s_any, s_any, s_real); pl_ttb = s7_make_circular_signature(s7, 2, 3, s_any, s_any, s_boolean); pl_tti = s7_make_circular_signature(s7, 2, 3, s_any, s_any, s_integer); + pl_tiit = s7_make_circular_signature(s7, 3, 4, s_any, s_integer, s_integer, s_any); pl_ttri = s7_make_circular_signature(s7, 3, 4, s_any, s_any, s_real, s_integer); pl_ttit = s7_make_circular_signature(s7, 3, 4, s_any, s_any, s_integer, s_any); pl_ttir = s7_make_circular_signature(s7, 3, 4, s_any, s_any, s_integer, s_real); + pl_tiir = s7_make_circular_signature(s7, 3, 4, s_any, s_integer, s_integer, s_real); pl_piit = s7_make_circular_signature(s7, 3, 4, s_any, s_integer, s_integer, s_any); + pl_tiib = s7_make_circular_signature(s7, 3, 4, s_any, s_integer, s_integer, s_boolean); + pl_tiiit = s7_make_circular_signature(s7, 4, 5, s_any, s_integer, s_integer, s_integer, s_any); pl_piiit = s7_make_circular_signature(s7, 4, 5, s_any, s_integer, s_integer, s_integer, s_any); + pl_tiiib = s7_make_circular_signature(s7, 4, 5, s_any, s_integer, s_integer, s_integer, s_boolean); pl_ttiti = s7_make_circular_signature(s7, 4, 5, s_any, s_any, s_integer, s_any, s_integer); pl_ttrri = s7_make_circular_signature(s7, 4, 5, s_any, s_any, s_real, s_real, s_integer); + pl_tiiiit = s7_make_circular_signature(s7, 5, 6, s_any, s_integer, s_integer, s_integer, s_integer, s_any); + pl_tirrir = s7_make_circular_signature(s7, 5, 6, s_any, s_integer, s_real, s_real, s_integer, s_real); pl_ttrrri = s7_make_circular_signature(s7, 5, 6, s_any, s_any, s_real, s_real, s_real, s_integer); + pl_tibiit = s7_make_circular_signature(s7, 5, 6, s_any, s_integer, s_boolean, s_integer, s_integer, s_any); + pl_tirriit = s7_make_circular_signature(s7, 6, 7, s_any, s_integer, s_real, s_real, s_integer, s_integer, s_any); pl_ttrriir = s7_make_circular_signature(s7, 6, 7, s_any, s_any, s_real, s_real, s_integer, s_integer, s_real); pl_ttititi = s7_make_circular_signature(s7, 6, 7, s_any, s_any, s_integer, s_any, s_integer, s_any, s_integer); + pl_iiiiiit = s7_make_circular_signature(s7, 6, 7, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); + pl_tiiiiit = s7_make_circular_signature(s7, 6, 7, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); + pl_tiirrrrt = s7_make_circular_signature(s7, 7, 8, s_any, s_integer, s_integer, s_real, s_real, s_real, s_real, s_any); + pl_tiiiiiiit = s7_make_circular_signature(s7, 8, 9, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); + pl_tiiiiiiiit = s7_make_circular_signature(s7, 9, 10, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); + pl_tirriirriit = s7_make_circular_signature(s7, 10, 11, s_any, s_integer, s_real, s_real, s_integer, s_integer, s_real, s_real, s_integer, s_integer, s_any); + pl_tiiiiiiiiit = s7_make_circular_signature(s7, 10, 11, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); + pl_tiiiiiiiiiit = s7_make_circular_signature(s7, 11, 12, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); + pl_iiiiitiiit = s7_make_circular_signature(s7, 9, 10, s_integer, s_integer, s_integer, s_integer, s_integer, s_any, s_integer, s_integer, s_integer, s_any); pl_ttititiiti = s7_make_circular_signature(s7, 9, 10, s_any, s_any, s_integer, s_any, s_integer, s_any, s_integer, s_integer, s_any, s_integer); + pl_iiiiiiiit = s7_make_circular_signature(s7, 8, 9, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); + pl_iiiiiiiiiiit = s7_make_circular_signature(s7, 11, 12, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); + pl_iiiiiiit = s7_make_circular_signature(s7, 7, 8, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); + pl_iiiiiiiiiit = s7_make_circular_signature(s7, 10, 11, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); + pl_iiiiiiiiit = s7_make_circular_signature(s7, 9, 10, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); + pl_tiiiiiit = s7_make_circular_signature(s7, 7, 8, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any); #if USE_MOTIF pl_pt = s7_make_circular_signature(s7, 1, 2, s_any, s_any); - pl_pttit = s7_make_circular_signature(s7, 4, 5, s_any, s_any, s_any, s_integer, s_any); pl_tttti = s7_make_circular_signature(s7, 4, 5, s_any, s_any, s_any, s_any, s_integer); pl_ttttb = s7_make_circular_signature(s7, 4, 5, s_any, s_any, s_any, s_any, s_boolean); + pl_pttit = s7_make_circular_signature(s7, 4, 5, s_any, s_any, s_any, s_integer, s_any); #endif #endif @@ -5736,7 +5736,7 @@ void Init_libgl(void) define_integers(); define_functions(); Xen_provide_feature("gl"); - Xen_define("gl-version", C_string_to_Xen_string("29-Jun-18")); + Xen_define("gl-version", C_string_to_Xen_string("29-Oct-18")); gl_already_inited = true; } } diff -pruN 19-1/heart.scm 19.0-1/heart.scm --- 19-1/heart.scm 2018-11-23 11:33:45.000000000 +0000 +++ 19.0-1/heart.scm 2018-11-17 11:52:45.000000000 +0000 @@ -1,4 +1,4 @@ -;;; use with-sound to write the data to a sound file +;;; use with-sound to write the data to a sound file: ./snd heart.scm medfly (require snd-ws.scm) ;;; turn off clipping (the numbers will be between 70 and 150) diff -pruN 19-1/HISTORY.Snd 19.0-1/HISTORY.Snd --- 19-1/HISTORY.Snd 2018-11-23 11:33:45.000000000 +0000 +++ 19.0-1/HISTORY.Snd 2019-01-01 12:51:44.000000000 +0000 @@ -1,5 +1,9 @@ Snd change log +2-Jan-19: Snd 19.0. + +2019 ---------------------------------------------------------------- + 20-Nov: Snd 18.9. 8-Oct: Snd 18.8. 31-Aug: Snd 18.7. diff -pruN 19-1/index.html 19.0-1/index.html --- 19-1/index.html 2018-11-23 11:33:45.000000000 +0000 +++ 19.0-1/index.html 2018-12-24 15:43:36.000000000 +0000 @@ -37,357 +37,357 @@
Index
- + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - +
*#readers*enved-waveform-colormacroexpandmus-sound-samplesscale-tempo
envelope-interpmain-menumus-sound-sratescale-to
A
enveloped-mixmain-widgetsmus-sound-type-specifierscan-channel
Envelopesmake-abcosmus-sound-write-datescanned synthesis
abcoseoddcosmake-absinmus-sratescentroid
abcos?eoddcos?make-adjustable-sawtooth-wavemus-widthscratch
aborteps-bottom-marginmake-adjustable-square-wavemus-xcoeffscript-arg
absineps-filemake-adjustable-triangle-wavemus-xcoeffsscript-args
absin?eps-left-marginmake-all-passmus-ycoeffScripting
add-amp-controlseps-sizemake-all-pass-bankmus-ycoeffssearch-for-click
add-colormapercosmake-asyfm search-procedure
add-delete-optionercos?make-asymmetric-fm
N
Searching
add-directory-to-view-files-list*error-hook*make-bandpass seconds->samples
add-file-filtererssbmake-bandstopn1cosselect-all
add-file-sortererssb?make-bessn1cos?select-channel
add-file-to-view-files-listeven-multiplemake-biquadname-click-hookselect-channel-hook
add-markeven-weightmake-birdsnchoosekcosselect-sound
add-mark-paneevery-sample?make-blackmannchoosekcos?select-sound-hook
add-playerexitmake-brown-noisencosselected-channel
add-sound-file-extensionexit-hookmake-byte-vectorncos2?selected-data-color
add-source-file-extensionexpand-controlmake-channel-drop-sitencos4?selected-graph-color
add-to-main-menuexpand-control-boundsmake-colorncos?selected-sound
add-to-menuexpand-control-hopmake-combnew-soundselection
add-tooltipexpand-control-jittermake-comb-banknew-sound-dialogselection->mix
add-transformexpand-control-lengthmake-convolvenew-sound-hookselection-chans
additive synthesisexpand-control-rampmake-delaynew-widget-hookselection-color
adjustable-sawtooth-waveexpand-control?make-differentiatornext-sampleselection-context
adjustable-sawtooth-wave?explode-sf2make-envnkssbselection-creates-region
adjustable-square-waveexponentially-weighted-moving-averagemake-eoddcosnkssb-interpselection-framples
adjustable-square-wave?expsndmake-ercosnkssb?selection-maxamp
adjustable-triangle-waveexpsrcmake-erssbnoddcosselection-maxamp-position
adjustable-triangle-wave? make-fft-windownoddcos?selection-member?
after-apply-controls-hook
F
make-file->framplenoddsinselection-members
after-edit-hook make-file->samplenoddsin?selection-position
after-graph-hook*features*make-filternoddssbselection-rms
after-lisp-graph-hookfeedback fmmake-filtered-combnoddssb?selection-srate
after-open-hookfftmake-filtered-comb-banknoidselection?
after-save-as-hookfft-cancelmake-fir-coeffsNoise ReductionSelections
after-save-state-hookfft-editmake-fir-filternormalize-channelset-samples
after-transform-hookfft-env-editmake-firmantnormalize-envelopesetter
all-chansfft-env-interpmake-float-vectornormalize-partialsshort-file-name
all-passfft-log-frequencymake-flocsignormalize-soundshow-axes
all-pass-bankfft-log-magnitudemake-fmssbnormalized-mixshow-controls
all-pass-bank?fft-smoothermake-formantnotchshow-disk-space
all-pass?fft-squelchmake-formant-banknotch-channelshow-full-duration
Alsafft-windowmake-frample->filenotch-selectionshow-full-range
amp-controlfft-window-alphamake-granulatenotch-soundshow-grid
amp-control-boundsfft-window-betamake-graph-datanotch?show-indices
amplitude-modulatefft-with-phasesmake-green-noisenpcos?show-listener
analyse-ladspaFFTsmake-green-noise-interpnrcosshow-marks
anoifile databasemake-hash-tablenrcos?show-mix-waveforms
any-env-channelfile->arraymake-highpassnrevshow-selection
any-randomfile->framplemake-hilbert-transformnrsinshow-selection-transform
apply-controlsfile->frample?make-hooknrsin?show-sonogram-cursor
apply-ladspafile->samplemake-iir-filternrssbshow-transform-peaks
aritable?file->sample?make-int-vectornrssb-interpshow-widget
arityfile-namemake-iteratornrssb?show-y-zero
array->filefile-name (generic)make-izcosnrxycossignature
array-interpfill!make-j0evencosnrxycos?silence-all-mixes
as-one-editfill! (generic)make-j0j1cosnrxysinsilence-mixes
ask-about-unsaved-editsfill-polygonmake-j2cosnrxysin?sinc-train
ask-before-overwritefill-rectanglemake-jjcosnsinsinc-train?
asyfm-Ifiltermake-jncosnsin?sinc-width
asyfm-Jfilter-channelmake-jpcosnsincossine-env-channel
asyfm?filter-control-coeffsmake-jycosnsincos?sine-ramp
asymmetric-fmfilter-control-envelopemake-k2cosnssbsinger
asymmetric-fm?filter-control-in-dBmake-k2sinnssb?smooth-channel
auto-resizefilter-control-in-hzmake-k2ssbnxy1cossmooth-selection
auto-savefilter-control-ordermake-k3sinnxy1cos?smooth-sound
auto-updatefilter-control-waveform-colormake-krksinnxy1sinSmoothing
auto-update-intervalfilter-control?make-locsignxy1sin?SMS synthesis
autocorrelatefilter-fftmake-lowpassnxycossnap-mark-to-beat
autoloadfilter-selectionmake-mix-samplernxycos?snap-marks
axis-colorfilter-selection-and-smoothmake-move-soundnxysinsnap-mix-to-beat
axis-infofilter-soundmake-moving-autocorrelationnxysin?snd->sample
axis-label-fontfilter?make-moving-average snd->sample?
axis-numbers-fontfiltered-combmake-moving-fft
O
snd-color
filtered-comb-bankmake-moving-max snd-error
B
filtered-comb-bank?make-moving-normobject->letsnd-error-hook
filtered-comb?make-moving-pitchobject->stringsnd-font
background-gradientFiltersmake-moving-scentroidodd-multiplesnd-gcs
bad-header-hookfind-dialogmake-moving-spectrumodd-weightsnd-help
bagpipefind-markmake-n1cosoffset-channelsnd-hooks
basic-colorfind-mixmake-nchoosekcosoffset-sound*snd-opened-sound*
beats-per-measurefind-soundmake-ncosone-polesnd-print
beats-per-minutefinfomake-nkssbone-pole-all-passsnd-spectrum
before-close-hookfinish-progress-reportmake-noddcosone-pole-all-pass?snd-tempnam
before-exit-hookfir-filtermake-noddsinone-pole?snd-url
before-save-as-hookfir-filter?make-noddssbone-zerosnd-urls
before-save-state-hookfirmantmake-noidone-zero?snd-version
before-transform-hookfirmant?make-notchopen-file-dialogsnd-warning
bes-j0fit-selection-between-marksmake-nrcosopen-file-dialog-directorysnd-warning-hook
bessflatten-partialsmake-nrsinopen-hooksndwarp
bess?float-vectormake-nrssbopen-next-file-in-directorysort!
bessel filtersfloat-vector*make-nrxycosopen-raw-soundSound placement
bigbirdfloat-vector+make-nrxysinopen-raw-sound-hooksound->amp-env
bignumfloat-vector->channelmake-nsinopen-soundsound->integer
bignum?float-vector->listmake-nsincosopenletsound-file-extensions
binary filesfloat-vector->stringmake-nssbopenlet?sound-file?
bind-keyfloat-vector-abs!make-nxy1cosorientation-hooksound-files-in-directory
birdfloat-vector-add!make-nxy1sinoscilsound-interp
blackmanfloat-vector-equal?make-nxycososcil-banksound-loop-info
blackman4-env-channelfloat-vector-fill!make-nxysinoscil-bank?sound-properties
blackman?float-vector-lengthmake-one-poleoscil?sound-property
bold-peaks-fontfloat-vector-maxmake-one-pole-all-passout-anysound-widgets
breakfloat-vector-minmake-one-zeroout-banksound?
brown-noisefloat-vector-move!make-osciloutasoundfont-info
brown-noise?float-vector-multiply!make-oscil-bankoutletsounds
butterworth filtersfloat-vector-offset!make-phase-vocoder*output*sounds->segment-data
byte-vectorfloat-vector-peakmake-pink-noiseoutput-comment-hookspectra
byte-vector->stringfloat-vector-polynomialmake-pixmapoverlay-rms-envspectral interpolation
byte-vector-reffloat-vector-refmake-playerowletspectral-polynomial
byte-vector-set!float-vector-reverse!make-polyoid spectro-hop
byte-vector?float-vector-scale!make-polyshape
P
spectro-x-angle
byte?float-vector-set!make-polywave spectro-x-scale
float-vector-subseqmake-pulse-trainpad-channelspectro-y-angle
C
float-vector-subtract!make-pulsed-envpad-marksspectro-y-scale
float-vector?make-r2k!cospad-soundspectro-z-angle
c-defineFloat-vectorsmake-r2k2cospair-filenamespectro-z-scale
c-g?flocsigmake-ramppair-line-numberspectrum
c-object-typeflocsig?make-randpan-mixspectrum->coeffs
c-object?flute modelmake-rand-interppan-mix-float-vectorspectrum-end
c-pointerfm-bellmake-rcospartials->polynomialspectrum-start
c-pointer->listfm-drummake-readinpartials->wavespeed-control
c-pointer-infofm-noisemake-regionpausingspeed-control-bounds
c-pointer-typefm-parallel-componentmake-region-samplerpeak-env-dirspeed-control-style
c-pointer-weak1fm-talkermake-rk!cospeaksspeed-control-tones
c-pointer?fm-trumpetmake-rk!ssbpeaks-fontspot-freq
call-with-exitfm-violinmake-rkcosphase-partials->wavesquare-wave
canterfm-voicemake-rkoddssbphase-vocodersquare-wave?
cascade->canonicalfmssbmake-rksinphase-vocoder?squelch-update
catchfmssb?make-rkssbPhysical Modelssquelch-vowels
cellonfocus-widgetmake-round-interppiano modelsrate
chain-dspsFOF synthesismake-rssbpink-noisesrate (generic)
channel->float-vectorfofinsmake-rxycospink-noise?src
channel-amp-envsfor-each-childmake-rxyk!cospinssrc-channel
channel-datafor-each-sound-filemake-rxyk!sinplace-soundsrc-duration
channel-envelopeForbidden Planetmake-rxysinplaysrc-fit-envelope
channel-polynomialforeground-colormake-sample->fileplay (generic)src-mixes
channel-propertiesforget-regionmake-samplerplay-arrow-sizesrc-selection
channel-propertyformantmake-sawtooth-waveplay-between-markssrc-sound
channel-rmsformant-bankmake-selectionplay-hooksrc?
channel-styleformant-bank?make-sinc-trainplay-mixesssb-am
channel-syncformant?make-snd->sampleplay-oftenssb-am?
channel-widgetsformatmake-sound-boxplay-region-foreverssb-bank
channelsForthmake-spencer-filterplay-sinessb-bank-env
channels (generic)fpmake-square-waveplay-sinesssb-fm
channels-equal?fractional-fourier-transformmake-srcplay-syncd-marksstart-dac
channels=?frample->filemake-ssb-amplay-until-c-gstart-playing
chansframple->file?make-table-lookupplay-with-envsstart-playing-hook
char-positionframple->framplemake-table-lookup-with-envplayer-homestart-playing-selection-hook
cheby-hkaframplesmake-tanhsinplayer?start-progress-report
chebyshev filtersframples (generic)make-triangle-waveplayersstatus-report
check-mix-tagsfree-playermake-two-poleplayingstdin-prompt
chordalizefree-samplermake-two-zeroPlayingstereo->mono
chorusfreeverbmake-variable-displaypluckstereo-flute
clean-channelFrequency Modulationmake-variable-graphPluginsstop-player
clean-soundfullmixmake-vectorpolar->rectangularstop-playing
clear-listenerfuncletmake-wave-trainpolynomialstop-playing-hook
clip-hook make-wave-train-with-envpolynomial operationsstop-playing-selection-hook
clipping
G
make-weak-hash-tablepolyoidstretch-envelope
clm-channel map-channelpolyoid-envstretch-sound-via-dft
clm-expsrcgaussian-distributionmap-sound-filespolyoid?string->byte-vector
close-hookgc-offmaracaspolyshapestring-position
close-soundgc-onmark->integerpolyshape?sublet
color->listGeneratorsmark-click-hookpolywavesubvector
color-cutoffgensymmark-click-infopolywave?subvector-position
color-hookgensym?mark-colorport-filenamesubvector-vector
color-invertedgl-graph->psmark-contextport-line-numbersubvector?
color-mixesglSpectrogrammark-drag-hookposition->xsuperimpose-ffts
color-orientation-dialoggoertzelmark-explodeposition->yswap-channels
color-scalegoto-listener-endmark-homeposition-colorswap-selection-channels
color?granimark-hookpower-envsymbol->dynamic-value
colormapGranular synthesismark-loopspqwsymbol->value
colormap->integergranulatemark-namepqw-voxsymbol-table
colormap-namegranulate?mark-name->idpreferences-dialogsync
colormap-refgranulated-sound-interpmark-propertiesprevious-samplesync (generic)
colormap-sizegraphmark-propertyprint-dialogsync-everything
colormap?graph->psmark-sampleprint-lengthsync-max
Colorsgraph-colormark-syncprocedure-sourcesync-style
combgraph-cursormark-sync-colorprogress-reportsyncd-marks
comb-bankgraph-datamark-sync-maxpulse-trainsyncd-mixes
comb-bank?graph-hookmark-tag-heightpulse-train?syncup
comb?graph-stylemark-tag-widthpulsed-env
combined-data-colorgraphic equalizermark?pulsed-env?
T
commentgraphs-horizontalMarking
Common Musicgreen-noisemarks
R
table-lookup
complexifygreen-noise-interpmatch-sound-files table-lookup?
concatenate-envelopesgreen-noise-interp?max-enveloper2k!costanhsin
constant?green-noise?max-regionsr2k!cos?tanhsin?
continuation?grid-densitymax-transform-peaksr2k2costap
continue-frample->file maxampr2k2cos?tap?
continue-sample->file
H
maxamp (generic)radians->degreestelephone
contrast-channel maxamp-positionradians->hztemp-dir
contrast-controlharmonicizerMaxampsramp-channeltext-focus-color
contrast-control-ampHartley transformmenu-widgetsrandtime-graph-style
contrast-control-boundshash-tablemenus, optionalrand-interptime-graph-type
contrast-control?hash-table*min-dBrand-interp?time-graph?
contrast-enhancementhash-table-entriesmixrand?times->samples
contrast-soundhash-table-refmix->float-vectorrandomtiny-font
Control Panelhash-table-set!mix->integerRandom Numberstouch-tone
controls->channelhash-table?mix-amprandom-statetrace
convolutionheader-typemix-amp-envrandom-state?Tracking cursors
convolution reverbHeaders and sample typesmix-channelrcostracking-cursor-style
convolvehello-dentistmix-click-hookrcos?transform->float-vector
convolve-fileshelp-dialogmix-click-info*read-error-hook*transform->integer
convolve-selection-withhelp-hookmix-click-sets-ampread-hooktransform-dialog
convolve-withhide-widgetmix-colorread-mix-sampletransform-framples
convolve?highlight-colormix-dialog-mixread-onlytransform-graph-style
copyhilbert-transformmix-drag-hookread-region-sampletransform-graph-type
copyhook-functionsmix-file-dialogread-sampletransform-graph?
copy (generic)hook-membermix-float-vectorread-sample-with-directiontransform-normalization
copy-contextHooksmix-homereader-condtransform-sample
copy-samplerhtmlmix-lengthreadintransform-size
Copyinghtml-dirmix-maxampreadin?transform-type
correlatehtml-programmix-namerectangular->magnitudestransform?
coverlethz->radiansmix-name->idrectangular->polartranspose-mixes
cross-fade (amplitude) mix-positionredotree-count
cross-fade (frequency domain)
I
mix-propertiesregion->float-vectortree-cyclic?
cross-synthesis mix-propertyregion->integertree-leaves
curletiir-filtermix-regionregion-chanstree-memq
current-fontiir-filter?mix-release-hookregion-framplestree-set-memq
cursorimmutable!mix-sampler?region-graph-styletriangle-wave
cursor-colorimmutable?mix-selectionregion-hometriangle-wave?
cursor-contextinmix-soundregion-maxamptubebell
cursor-location-offsetin-anymix-speedregion-maxamp-positiontubular bell
cursor-positioninamix-syncregion-play-listtwo-pole
cursor-sizeinbmix-sync-maxregion-positiontwo-pole?
cursor-styleinfo-dialogmix-tag-heightregion-rmstwo-tab
cursor-update-intervalinit-ladspamix-tag-widthregion-sampletwo-zero
Cursorsinitial-begmix-tag-yregion-sampler?two-zero?
cutletinitial-durmix-waveform-heightregion-sratetype-of
cyclic-sequencesinitial-graph-hookmix?region?
Initialization filemixesregions
U
D
inletMixingRegions
insert-channelmono->stereoremember-sound-stateunbind-key
dac-combines-channelsinsert-file-dialogmoog-filterremove-clicks*unbound-variable-hook*
dac-sizeinsert-regionmorally-equal?remove-from-menuunclip-channel
data-colorinsert-samplemouse-click-hookreplace-with-selectionundo
data-locationinsert-samplesmouse-drag-hookreport-mark-namesUndo and Redo
data-sizeinsert-selectionmouse-enter-graph-hookrequireundo-hook
db->linearinsert-silencemouse-enter-label-hookResamplingunlet
Debugging (C)insert-soundmouse-enter-listener-hookreset-all-hooksunselect-all
Debugging (instruments)Insertionsmouse-enter-text-hookreset-controlsupdate-graphs
Debugging (Scheme)int-vectormouse-leave-graph-hookreset-listener-cursorupdate-hook
default-output-chansint-vector-refmouse-leave-label-hookresonupdate-lisp-graph
default-output-header-typeint-vector-set!mouse-leave-listener-hookrestore-controlsupdate-sound
default-output-sample-typeint-vector?mouse-leave-text-hookReverbupdate-time-graph
default-output-srateinteger->colormapmouse-press-hook*reverb*update-transform-graph
defgeneratorinteger->markmove-locsigreverb-control-decayupon-save-yourself
define*integer->mixmove-mixesreverb-control-feedbackuser interface extensions
define-constantinteger->regionmove-soundreverb-control-length
define-envelopeinteger->soundmove-sound?reverb-control-length-bounds
V
define-expansioninteger->transformmove-syncd-marksreverb-control-lowpass
define-macrointegrate-envelopemoving-autocorrelationreverb-control-scalevariable-display
define-macro*invert-filtermoving-autocorrelation?reverb-control-scale-boundsvariable-graph?
define-selection-via-marksInvocation flagsmoving-averagereverb-control?varlet
defined?iteratemoving-average?reverse!vibrating-uniform-circular-string
degrees->radiansiterator-at-end?moving-fftreverse-by-blocksview-files-amp
delayiterator-sequencemoving-fft?reverse-channelview-files-amp-env
delay-channel-mixesiterator?moving-lengthreverse-envelopeview-files-dialog
delay-tickizcosmoving-maxreverse-selectionview-files-files
delay?izcos?moving-max?reverse-soundview-files-select-hook
delete-colormap moving-normReversingview-files-selected-files
delete-file-filter
J
moving-norm?revert-soundview-files-sort
delete-file-sorter moving-pitchright-sampleview-files-speed
delete-markj0evencosmoving-pitch?ring-modulateview-files-speed-style
delete-marksj0evencos?moving-rmsrk!cosview-mixes-dialog
delete-samplej0j1cosmoving-scentroidrk!cos?view-regions-dialog
delete-samplesj0j1cos?moving-scentroid?rk!ssbview-sound
delete-samples-and-smoothj2cosmoving-spectrumrk!ssb?voice physical model
delete-selectionj2cos?moving-spectrum?rkcosvoiced->unvoiced
delete-selection-and-smoothJackmoving-sumrkcos?volterra-filter
delete-transformjc-reverbmpgrkoddssbvox
Deletionsjjcosmus-alsa-buffer-sizerkoddssb?
describe-hookjjcos?mus-alsa-buffersrksin
W
describe-markjncosmus-alsa-capture-devicerksin?
dhtjncos?mus-alsa-devicerkssbwave-train
dialog-widgetsjpcosmus-alsa-playback-devicerkssb?wave-train?
dilambdajpcos?mus-alsa-squelch-warningrmswavelet-type
disable-control-paneljust-soundsmus-array-print-lengthrms, gain, balance genswaveshaping voice
display-bark-fftjycosmus-bytes-per-samplerms-envelopewavo-hop
display-correlationjycos?mus-channelrootletwavo-trace
display-db mus-channels*rootlet-redefinition-hook*weak-hash-table?
display-edits
K
mus-chebyshev-tu-sumround-interpweighted-moving-average
display-energy mus-clippinground-interp?widget-position
dissolve-fadek2cosmus-closerssbwidget-size
dither-channelk2cos?mus-copyrssb-interpwidget-text
dither-soundk2sinmus-datarssb?Window size and position
documentationk2sin?mus-describerubber-soundwindow-height
dolphk2ssbmus-error-hookRubywindow-samples
dot-productk2ssb?mus-error-type->stringrxycoswindow-width
dot-sizek3sinmus-expand-filenamerxycos?window-x
down-octk3sin?mus-feedbackrxyk!coswindow-y
draw-axeskalman-filter-channelmus-feedforwardrxyk!cos?with-background-processes
draw-dotkeymus-fftrxyk!sinwith-baffle
draw-dotskey-bindingmus-file-buffer-sizerxyk!sin?with-file-monitor
draw-linekey-press-hookmus-file-clippingrxysinwith-gl
draw-lineskrksinmus-file-mixrxysin?with-inset-graph
draw-mark-hookkrksin?mus-file-name with-interrupts
draw-mix-hook mus-float-equal-fudge-factor
S
with-let
draw-string
L
mus-frequency with-local-hook
drone mus-generator?s7 schemewith-menu-icons
drop sitesladspa-descriptormus-header-raw-defaultssamplewith-mix-tags
drop-hookladspa-dirmus-header-type->stringsample->filewith-pointer-focus
during-open-hooklambda*mus-header-type-namesample->file?with-relative-panes
lbj-pianomus-hopsample-typewith-smpte-label
E
left-samplemus-incrementsampler-at-end?with-sound
length (generic)mus-input?sampler-homewith-temporary-selection
Edit listslet->listmus-interp-typesampler-positionwith-toolbar
edit-fragmentlet-refmus-interpolatesampler?with-tooltips
edit-header-dialoglet-set!mus-lengthsamplerswith-tracking-cursor
edit-hooklet-temporarilymus-locationsampleswith-verbose-cursor
edit-list->functionlet?mus-max-mallocsamples->seconds
edit-positionlinear->dbmus-max-table-sizesash-color
X
edit-propertieslinear-src-channelmus-namesave-as-dialog-auto-comment
edit-propertylint for schememus-offsetsave-as-dialog-srcx->position
edit-treelisp-graph-hookmus-ordersave-controlsx-axis-label
editslisp-graph-stylemus-oss-set-bufferssave-dirx-axis-style
edot-productlisp-graph?mus-output?save-edit-historyx-bounds
effects-hooklist->float-vectormus-phasesave-envelopesx-position-slider
elliptic filterslist-ladspamus-rampsave-hookx-zoom-slider
Emacs and Sndlistener-click-hookmus-rand-seedsave-listenerxb-open
envlistener-colormus-randomsave-mark-propertiesxramp-channel
env-anylistener-colorizedmus-resetsave-marks
env-channellistener-fontmus-runsave-mix
Y
env-channel-with-baselistener-promptmus-sample-type->stringsave-region
env-expt-channellistener-selectionmus-sample-type-namesave-region-dialogy->position
env-interplistener-text-colormus-scalersave-selectiony-axis-label
env-mixeslittle-endian?mus-sound-chanssave-selection-dialogy-bounds
env-selection*load-hook*mus-sound-commentsave-soundy-position-slider
env-sound*load-path*mus-sound-data-locationsave-sound-asy-zoom-slider
env-sound-interplocate-zeromus-sound-datum-sizesave-sound-dialog
env-squared-channellocsigmus-sound-durationsave-state
Z
env?locsig-refmus-sound-forgetsave-state-file
enved-baselocsig-reverb-refmus-sound-framplessave-state-hookz-transform
enved-clip?locsig-reverb-set!mus-sound-header-typeSavingzecho
enved-dialoglocsig-set!mus-sound-lengthsavitzky-golay-filterzero+
enved-envelopelocsig-typemus-sound-loop-infosawtooth-wavezero-pad
enved-filterlocsig?mus-sound-mark-infosawtooth-wave?zero-phase
enved-filter-orderlog-freq-startmus-sound-maxampscale-byzip-sound
enved-hooklpc-coeffsmus-sound-maxamp-exists?scale-channelzipper
enved-in-dBlpc-predictmus-sound-pathscale-envelopezoom-color
enved-power mus-sound-preloadscale-mixeszoom-focus-style
enved-style
M
mus-sound-prunescale-selection-by
*#readers*enved-waveform-colormain-menumus-sound-sratescale-to
envelope-interpmain-widgetsmus-sound-type-specifierscan-channel
A
enveloped-mixmake-abcosmus-sound-write-datescanned synthesis
Envelopesmake-absinmus-sratescentroid
abcoseoddcosmake-adjustable-sawtooth-wavemus-widthscratch
abcos?eoddcos?make-adjustable-square-wavemus-xcoeffscript-arg
aborteps-bottom-marginmake-adjustable-triangle-wavemus-xcoeffsscript-args
absineps-filemake-all-passmus-ycoeffScripting
absin?eps-left-marginmake-all-pass-bankmus-ycoeffssearch-for-click
add-amp-controlseps-sizemake-asyfm search-procedure
add-colormapercosmake-asymmetric-fm
N
Searching
add-delete-optionercos?make-bandpass seconds->samples
add-directory-to-view-files-list*error-hook*make-bandstopn1cosselect-all
add-file-filtererssbmake-bessn1cos?select-channel
add-file-sortererssb?make-biquadname-click-hookselect-channel-hook
add-file-to-view-files-listeven-multiplemake-birdsnchoosekcosselect-sound
add-markeven-weightmake-blackmannchoosekcos?select-sound-hook
add-mark-paneevery-sample?make-brown-noisencosselected-channel
add-playerexitmake-byte-vectorncos2?selected-data-color
add-sound-file-extensionexit-hookmake-channel-drop-sitencos4?selected-graph-color
add-source-file-extensionexpand-controlmake-colorncos?selected-sound
add-to-main-menuexpand-control-boundsmake-combnew-soundselection
add-to-menuexpand-control-hopmake-comb-banknew-sound-dialogselection->mix
add-tooltipexpand-control-jittermake-convolvenew-sound-hookselection-chans
add-transformexpand-control-lengthmake-delaynew-widget-hookselection-color
additive synthesisexpand-control-rampmake-differentiatornext-sampleselection-context
adjustable-sawtooth-waveexpand-control?make-envnkssbselection-creates-region
adjustable-sawtooth-wave?explode-sf2make-eoddcosnkssb-interpselection-framples
adjustable-square-waveexponentially-weighted-moving-averagemake-ercosnkssb?selection-maxamp
adjustable-square-wave?expsndmake-erssbnoddcosselection-maxamp-position
adjustable-triangle-waveexpsrcmake-fft-windownoddcos?selection-member?
adjustable-triangle-wave? make-file->framplenoddsinselection-members
after-apply-controls-hook
F
make-file->samplenoddsin?selection-position
after-edit-hook make-filternoddssbselection-rms
after-graph-hook*features*make-filtered-combnoddssb?selection-srate
after-lisp-graph-hookfeedback fmmake-filtered-comb-banknoidselection?
after-open-hookfftmake-fir-coeffsNoise ReductionSelections
after-save-as-hookfft-cancelmake-fir-filternormalize-channelset-samples
after-save-state-hookfft-editmake-firmantnormalize-envelopesetter
after-transform-hookfft-env-editmake-float-vectornormalize-partialsshort-file-name
all-chansfft-env-interpmake-flocsignormalize-soundshow-axes
all-passfft-log-frequencymake-fmssbnormalized-mixshow-controls
all-pass-bankfft-log-magnitudemake-formantnotchshow-disk-space
all-pass-bank?fft-smoothermake-formant-banknotch-channelshow-full-duration
all-pass?fft-squelchmake-frample->filenotch-selectionshow-full-range
Alsafft-windowmake-granulatenotch-soundshow-grid
amp-controlfft-window-alphamake-graph-datanotch?show-indices
amp-control-boundsfft-window-betamake-green-noisenpcos?show-listener
amplitude-modulatefft-with-phasesmake-green-noise-interpnrcosshow-marks
analyse-ladspaFFTsmake-hash-tablenrcos?show-mix-waveforms
anoifile databasemake-highpassnrevshow-selection
any-env-channelfile->arraymake-hilbert-transformnrsinshow-selection-transform
any-randomfile->framplemake-hooknrsin?show-sonogram-cursor
apply-controlsfile->frample?make-iir-filternrssbshow-transform-peaks
apply-ladspafile->samplemake-int-vectornrssb-interpshow-widget
aritable?file->sample?make-iteratornrssb?show-y-zero
arityfile-namemake-izcosnrxycossignature
array->filefile-name (generic)make-j0evencosnrxycos?silence-all-mixes
array-interpfill!make-j0j1cosnrxysinsilence-mixes
as-one-editfill! (generic)make-j2cosnrxysin?sinc-train
ask-about-unsaved-editsfill-polygonmake-jjcosnsinsinc-train?
ask-before-overwritefill-rectanglemake-jncosnsin?sinc-width
asyfm-Ifiltermake-jpcosnsincossine-env-channel
asyfm-Jfilter-channelmake-jycosnsincos?sine-ramp
asyfm?filter-control-coeffsmake-k2cosnssbsinger
asymmetric-fmfilter-control-envelopemake-k2sinnssb?smooth-channel
asymmetric-fm?filter-control-in-dBmake-k2ssbnxy1cossmooth-selection
auto-resizefilter-control-in-hzmake-k3sinnxy1cos?smooth-sound
auto-savefilter-control-ordermake-krksinnxy1sinSmoothing
auto-updatefilter-control-waveform-colormake-locsignxy1sin?SMS synthesis
auto-update-intervalfilter-control?make-lowpassnxycossnap-mark-to-beat
autocorrelatefilter-fftmake-mix-samplernxycos?snap-marks
autoloadfilter-selectionmake-move-soundnxysinsnap-mix-to-beat
axis-colorfilter-selection-and-smoothmake-moving-autocorrelationnxysin?snd->sample
axis-infofilter-soundmake-moving-average snd->sample?
axis-label-fontfilter?make-moving-fft
O
snd-color
axis-numbers-fontfiltered-combmake-moving-max snd-error
filtered-comb-bankmake-moving-normobject->letsnd-error-hook
B
filtered-comb-bank?make-moving-pitchobject->stringsnd-font
filtered-comb?make-moving-scentroidodd-multiplesnd-gcs
background-gradientFiltersmake-moving-spectrumodd-weightsnd-help
bad-header-hookfind-dialogmake-n1cosoffset-channelsnd-hooks
bagpipefind-markmake-nchoosekcosoffset-sound*snd-opened-sound*
basic-colorfind-mixmake-ncosone-polesnd-print
beats-per-measurefind-soundmake-nkssbone-pole-all-passsnd-spectrum
beats-per-minutefinfomake-noddcosone-pole-all-pass?snd-tempnam
before-close-hookfinish-progress-reportmake-noddsinone-pole?snd-url
before-exit-hookfir-filtermake-noddssbone-zerosnd-urls
before-save-as-hookfir-filter?make-noidone-zero?snd-version
before-save-state-hookfirmantmake-notchopen-file-dialogsnd-warning
before-transform-hookfirmant?make-nrcosopen-file-dialog-directorysnd-warning-hook
bes-j0fit-selection-between-marksmake-nrsinopen-hooksndwarp
bessflatten-partialsmake-nrssbopen-next-file-in-directorysort!
bess?float-vectormake-nrxycosopen-raw-soundSound placement
bessel filtersfloat-vector*make-nrxysinopen-raw-sound-hooksound->amp-env
bigbirdfloat-vector+make-nsinopen-soundsound->integer
bignumfloat-vector->channelmake-nsincosopenletsound-file-extensions
bignum?float-vector->listmake-nssbopenlet?sound-file?
binary filesfloat-vector->stringmake-nxy1cosorientation-hooksound-files-in-directory
bind-keyfloat-vector-abs!make-nxy1sinoscilsound-interp
birdfloat-vector-add!make-nxycososcil-banksound-loop-info
blackmanfloat-vector-equal?make-nxysinoscil-bank?sound-properties
blackman4-env-channelfloat-vector-fill!make-one-poleoscil?sound-property
blackman?float-vector-lengthmake-one-pole-all-passout-anysound-widgets
bold-peaks-fontfloat-vector-maxmake-one-zeroout-banksound?
breakfloat-vector-minmake-osciloutasoundfont-info
brown-noisefloat-vector-move!make-oscil-bankoutletsounds
brown-noise?float-vector-multiply!make-phase-vocoder*output*sounds->segment-data
butterworth filtersfloat-vector-offset!make-pink-noiseoutput-comment-hookspectra
byte-vectorfloat-vector-peakmake-pixmapoverlay-rms-envspectral interpolation
byte-vector->stringfloat-vector-polynomialmake-playerowletspectral-polynomial
byte-vector-reffloat-vector-refmake-polyoid spectro-hop
byte-vector-set!float-vector-reverse!make-polyshape
P
spectro-x-angle
byte-vector?float-vector-scale!make-polywave spectro-x-scale
byte?float-vector-set!make-pulse-trainpad-channelspectro-y-angle
float-vector-subseqmake-pulsed-envpad-marksspectro-y-scale
C
float-vector-subtract!make-r2k!cospad-soundspectro-z-angle
float-vector?make-r2k2cospair-filenamespectro-z-scale
c-defineFloat-vectorsmake-ramppair-line-numberspectrum
c-g?flocsigmake-randpan-mixspectrum->coeffs
c-object-typeflocsig?make-rand-interppan-mix-float-vectorspectrum-end
c-object?flute modelmake-rcospartials->polynomialspectrum-start
c-pointerfm-bellmake-readinpartials->wavespeed-control
c-pointer->listfm-drummake-regionpausingspeed-control-bounds
c-pointer-infofm-noisemake-region-samplerpeak-env-dirspeed-control-style
c-pointer-typefm-parallel-componentmake-rk!cospeaksspeed-control-tones
c-pointer-weak1fm-talkermake-rk!ssbpeaks-fontspot-freq
c-pointer?fm-trumpetmake-rkcosphase-partials->wavesquare-wave
call-with-exitfm-violinmake-rkoddssbphase-vocodersquare-wave?
canterfm-voicemake-rksinphase-vocoder?squelch-update
cascade->canonicalfmssbmake-rkssbPhysical Modelssquelch-vowels
catchfmssb?make-round-interppiano modelsrate
cellonfocus-widgetmake-rssbpink-noisesrate (generic)
chain-dspsFOF synthesismake-rxycospink-noise?src
channel->float-vectorfofinsmake-rxyk!cospinssrc-channel
channel-amp-envsfor-each-childmake-rxyk!sinplace-soundsrc-duration
channel-datafor-each-sound-filemake-rxysinplaysrc-fit-envelope
channel-envelopeForbidden Planetmake-sample->fileplay (generic)src-mixes
channel-polynomialforeground-colormake-samplerplay-arrow-sizesrc-selection
channel-propertiesforget-regionmake-sawtooth-waveplay-between-markssrc-sound
channel-propertyformantmake-selectionplay-hooksrc?
channel-rmsformant-bankmake-sinc-trainplay-mixesssb-am
channel-styleformant-bank?make-snd->sampleplay-oftenssb-am?
channel-syncformant?make-sound-boxplay-region-foreverssb-bank
channel-widgetsformatmake-spencer-filterplay-sinessb-bank-env
channelsForthmake-square-waveplay-sinesssb-fm
channels (generic)fpmake-srcplay-syncd-marksstart-dac
channels-equal?fractional-fourier-transformmake-ssb-amplay-until-c-gstart-playing
channels=?frample->filemake-table-lookupplay-with-envsstart-playing-hook
chansframple->file?make-table-lookup-with-envplayer-homestart-playing-selection-hook
char-positionframple->framplemake-tanhsinplayer?start-progress-report
cheby-hkaframplesmake-triangle-waveplayersstatus-report
chebyshev filtersframples (generic)make-two-poleplayingstdin-prompt
check-mix-tagsfree-playermake-two-zeroPlayingstereo->mono
chordalizefree-samplermake-variable-displaypluckstereo-flute
chorusfreeverbmake-variable-graphPluginsstop-player
clean-channelFrequency Modulationmake-vectorpolar->rectangularstop-playing
clean-soundfullmixmake-wave-trainpolynomialstop-playing-hook
clear-listenerfuncletmake-wave-train-with-envpolynomial operationsstop-playing-selection-hook
clip-hook make-weak-hash-tablepolyoidstretch-envelope
clipping
G
map-channelpolyoid-envstretch-sound-via-dft
clm-channel map-sound-filespolyoid?string->byte-vector
clm-expsrcgaussian-distributionmaracaspolyshapestring-position
close-hookgc-offmark->integerpolyshape?sublet
close-soundgc-onmark-click-hookpolywavesubvector
color->listGeneratorsmark-click-infopolywave?subvector-position
color-cutoffgensymmark-colorport-filenamesubvector-vector
color-hookgensym?mark-contextport-line-numbersubvector?
color-invertedgl-graph->psmark-drag-hookposition->xsuperimpose-ffts
color-mixesglSpectrogrammark-explodeposition->yswap-channels
color-orientation-dialoggoertzelmark-homeposition-colorswap-selection-channels
color-scalegoto-listener-endmark-hookpower-envsymbol->dynamic-value
color?granimark-loopspqwsymbol->value
colormapGranular synthesismark-namepqw-voxsymbol-table
colormap->integergranulatemark-name->idpreferences-dialogsync
colormap-namegranulate?mark-propertiesprevious-samplesync (generic)
colormap-refgranulated-sound-interpmark-propertyprint-dialogsync-everything
colormap-sizegraphmark-sampleprint-lengthsync-max
colormap?graph->psmark-syncprocedure-sourcesync-style
Colorsgraph-colormark-sync-colorprogress-reportsyncd-marks
combgraph-cursormark-sync-maxpulse-trainsyncd-mixes
comb-bankgraph-datamark-tag-heightpulse-train?syncup
comb-bank?graph-hookmark-tag-widthpulsed-env
comb?graph-stylemark?pulsed-env?
T
combined-data-colorgraphic equalizerMarking
commentgraphs-horizontalmarks
R
table-lookup
Common Musicgreen-noisematch-sound-files table-lookup?
complexifygreen-noise-interpmax-enveloper2k!costanhsin
concatenate-envelopesgreen-noise-interp?max-regionsr2k!cos?tanhsin?
constant?green-noise?max-transform-peaksr2k2costap
continuation?grid-densitymaxampr2k2cos?tap?
continue-frample->file maxamp (generic)radians->degreestelephone
continue-sample->file
H
maxamp-positionradians->hztemp-dir
contrast-channel Maxampsramp-channeltext-focus-color
contrast-controlharmonicizermenu-widgetsrandtime-graph-style
contrast-control-ampHartley transformmenus, optionalrand-interptime-graph-type
contrast-control-boundshash-tablemin-dBrand-interp?time-graph?
contrast-control?hash-table-entriesmixrand?times->samples
contrast-enhancementhash-table-refmix->float-vectorrandomtiny-font
contrast-soundhash-table-set!mix->integerRandom Numberstouch-tone
Control Panelhash-table?mix-amprandom-statetrace
controls->channelheader-typemix-amp-envrandom-state?Tracking cursors
convolutionHeaders and sample typesmix-channelrcostracking-cursor-style
convolution reverbhello-dentistmix-click-hookrcos?transform->float-vector
convolvehelp-dialogmix-click-info*read-error-hook*transform->integer
convolve-fileshelp-hookmix-click-sets-ampread-hooktransform-dialog
convolve-selection-withhide-widgetmix-colorread-mix-sampletransform-framples
convolve-withhighlight-colormix-dialog-mixread-onlytransform-graph-style
convolve?hilbert-transformmix-drag-hookread-region-sampletransform-graph-type
copyhook-functionsmix-file-dialogread-sampletransform-graph?
copyhook-membermix-float-vectorread-sample-with-directiontransform-normalization
copy (generic)Hooksmix-homereader-condtransform-sample
copy-contexthtmlmix-lengthreadintransform-size
copy-samplerhtml-dirmix-maxampreadin?transform-type
Copyinghtml-programmix-namerectangular->magnitudestransform?
correlatehz->radiansmix-name->idrectangular->polartranspose-mixes
coverlet mix-positionredotree-count
cross-fade (amplitude)
I
mix-propertiesregion->float-vectortree-cyclic?
cross-fade (frequency domain) mix-propertyregion->integertree-leaves
cross-synthesisiir-filtermix-regionregion-chanstree-memq
curletiir-filter?mix-release-hookregion-framplestree-set-memq
current-fontimmutable!mix-sampler?region-graph-styletriangle-wave
cursorimmutable?mix-selectionregion-hometriangle-wave?
cursor-colorinmix-soundregion-maxamptubebell
cursor-contextin-anymix-speedregion-maxamp-positiontubular bell
cursor-location-offsetinamix-syncregion-play-listtwo-pole
cursor-positioninbmix-sync-maxregion-positiontwo-pole?
cursor-sizeinfo-dialogmix-tag-heightregion-rmstwo-tab
cursor-styleinit-ladspamix-tag-widthregion-sampletwo-zero
cursor-update-intervalinitial-begmix-tag-yregion-sampler?two-zero?
Cursorsinitial-durmix-waveform-heightregion-sratetype-of
cutletinitial-graph-hookmix?region?
cyclic-sequencesInitialization filemixesregions
U
inletMixingRegions
D
insert-channelmono->stereoremember-sound-stateunbind-key
insert-file-dialogmoog-filterremove-clicks*unbound-variable-hook*
dac-combines-channelsinsert-regionmorally-equal?remove-from-menuunclip-channel
dac-sizeinsert-samplemouse-click-hookreplace-with-selectionundo
data-colorinsert-samplesmouse-drag-hookreport-mark-namesUndo and Redo
data-locationinsert-selectionmouse-enter-graph-hookrequireundo-hook
data-sizeinsert-silencemouse-enter-label-hookResamplingunlet
db->linearinsert-soundmouse-enter-listener-hookreset-all-hooksunselect-all
Debugging (C)Insertionsmouse-enter-text-hookreset-controlsupdate-graphs
Debugging (instruments)int-vectormouse-leave-graph-hookreset-listener-cursorupdate-hook
Debugging (Scheme)int-vector-refmouse-leave-label-hookresonupdate-lisp-graph
default-output-chansint-vector-set!mouse-leave-listener-hookrestore-controlsupdate-sound
default-output-header-typeint-vector?mouse-leave-text-hookReverbupdate-time-graph
default-output-sample-typeinteger->colormapmouse-press-hook*reverb*update-transform-graph
default-output-srateinteger->markmove-locsigreverb-control-decayupon-save-yourself
defgeneratorinteger->mixmove-mixesreverb-control-feedbackuser interface extensions
define*integer->regionmove-soundreverb-control-length
define-constantinteger->soundmove-sound?reverb-control-length-bounds
V
define-envelopeinteger->transformmove-syncd-marksreverb-control-lowpass
define-expansionintegrate-envelopemoving-autocorrelationreverb-control-scalevariable-display
define-macroinvert-filtermoving-autocorrelation?reverb-control-scale-boundsvariable-graph?
define-macro*Invocation flagsmoving-averagereverb-control?varlet
define-selection-via-marksiteratemoving-average?reverse!vibrating-uniform-circular-string
defined?iterator-at-end?moving-fftreverse-by-blocksview-files-amp
degrees->radiansiterator-sequencemoving-fft?reverse-channelview-files-amp-env
delayiterator?moving-lengthreverse-envelopeview-files-dialog
delay-channel-mixesizcosmoving-maxreverse-selectionview-files-files
delay-tickizcos?moving-max?reverse-soundview-files-select-hook
delay? moving-normReversingview-files-selected-files
delete-colormap
J
moving-norm?revert-soundview-files-sort
delete-file-filter moving-pitchright-sampleview-files-speed
delete-file-sorterj0evencosmoving-pitch?ring-modulateview-files-speed-style
delete-markj0evencos?moving-rmsrk!cosview-mixes-dialog
delete-marksj0j1cosmoving-scentroidrk!cos?view-regions-dialog
delete-samplej0j1cos?moving-scentroid?rk!ssbview-sound
delete-samplesj2cosmoving-spectrumrk!ssb?voice physical model
delete-samples-and-smoothj2cos?moving-spectrum?rkcosvoiced->unvoiced
delete-selectionJackmoving-sumrkcos?volterra-filter
delete-selection-and-smoothjc-reverbmpgrkoddssbvox
delete-transformjjcosmus-alsa-buffer-sizerkoddssb?
Deletionsjjcos?mus-alsa-buffersrksin
W
describe-hookjncosmus-alsa-capture-devicerksin?
describe-markjncos?mus-alsa-devicerkssbwave-train
dhtjpcosmus-alsa-playback-devicerkssb?wave-train?
dialog-widgetsjpcos?mus-alsa-squelch-warningrmswavelet-type
dilambdajust-soundsmus-array-print-lengthrms, gain, balance genswaveshaping voice
disable-control-paneljycosmus-bytes-per-samplerms-envelopewavo-hop
display-bark-fftjycos?mus-channelrootletwavo-trace
display-correlation mus-channels*rootlet-redefinition-hook*weak-hash-table
display-db
K
mus-chebyshev-tu-sumround-interpweak-hash-table?
display-edits mus-clippinground-interp?weighted-moving-average
display-energyk2cosmus-closerssbwidget-position
dissolve-fadek2cos?mus-copyrssb-interpwidget-size
dither-channelk2sinmus-datarssb?widget-text
dither-soundk2sin?mus-describerubber-soundWindow size and position
documentationk2ssbmus-error-hookRubywindow-height
dolphk2ssb?mus-error-type->stringrxycoswindow-samples
dot-productk3sinmus-expand-filenamerxycos?window-width
dot-sizek3sin?mus-feedbackrxyk!coswindow-x
down-octkalman-filter-channelmus-feedforwardrxyk!cos?window-y
draw-axeskeymus-fftrxyk!sinwith-background-processes
draw-dotkey-bindingmus-file-buffer-sizerxyk!sin?with-baffle
draw-dotskey-press-hookmus-file-clippingrxysinwith-file-monitor
draw-linekrksinmus-file-mixrxysin?with-gl
draw-lineskrksin?mus-file-name with-inset-graph
draw-mark-hook mus-float-equal-fudge-factor
S
with-interrupts
draw-mix-hook
L
mus-frequency with-let
draw-string mus-generator?s7 schemewith-local-hook
droneladspa-descriptormus-header-raw-defaultssamplewith-menu-icons
drop sitesladspa-dirmus-header-type->stringsample->filewith-mix-tags
drop-hooklambda*mus-header-type-namesample->file?with-pointer-focus
during-open-hooklbj-pianomus-hopsample-typewith-relative-panes
left-samplemus-incrementsampler-at-end?with-smpte-label
E
length (generic)mus-input?sampler-homewith-sound
let->listmus-interp-typesampler-positionwith-temporary-selection
Edit listslet-refmus-interpolatesampler?with-toolbar
edit-fragmentlet-set!mus-lengthsamplerswith-tooltips
edit-header-dialoglet-temporarilymus-locationsampleswith-tracking-cursor
edit-hooklet?mus-max-mallocsamples->secondswith-verbose-cursor
edit-list->functionlinear->dbmus-max-table-sizesash-color
edit-positionlinear-src-channelmus-namesave-as-dialog-auto-comment
X
edit-propertieslint for schememus-offsetsave-as-dialog-src
edit-propertylisp-graph-hookmus-ordersave-controlsx->position
edit-treelisp-graph-stylemus-oss-set-bufferssave-dirx-axis-label
editslisp-graph?mus-output?save-edit-historyx-axis-style
edot-productlist->float-vectormus-phasesave-envelopesx-bounds
effects-hooklist-ladspamus-rampsave-hookx-position-slider
elliptic filterslistener-click-hookmus-rand-seedsave-listenerx-zoom-slider
Emacs and Sndlistener-colormus-randomsave-mark-propertiesxb-open
envlistener-colorizedmus-resetsave-marksxramp-channel
env-anylistener-fontmus-runsave-mix
env-channellistener-promptmus-sample-type->stringsave-region
Y
env-channel-with-baselistener-selectionmus-sample-type-namesave-region-dialog
env-expt-channellistener-text-colormus-scalersave-selectiony->position
env-interplittle-endian?mus-sound-chanssave-selection-dialogy-axis-label
env-mixes*load-hook*mus-sound-commentsave-soundy-bounds
env-selection*load-path*mus-sound-data-locationsave-sound-asy-position-slider
env-soundlocate-zeromus-sound-datum-sizesave-sound-dialogy-zoom-slider
env-sound-interplocsigmus-sound-durationsave-state
env-squared-channellocsig-refmus-sound-forgetsave-state-file
Z
env?locsig-reverb-refmus-sound-framplessave-state-hook
enved-baselocsig-reverb-set!mus-sound-header-typeSavingz-transform
enved-clip?locsig-set!mus-sound-lengthsavitzky-golay-filterzecho
enved-dialoglocsig-typemus-sound-loop-infosawtooth-wavezero+
enved-envelopelocsig?mus-sound-mark-infosawtooth-wave?zero-pad
enved-filterlog-freq-startmus-sound-maxampscale-byzero-phase
enved-filter-orderlpc-coeffsmus-sound-maxamp-exists?scale-channelzip-sound
enved-hooklpc-predictmus-sound-pathscale-envelopezipper
enved-in-dB mus-sound-preloadscale-mixeszoom-color
enved-power
M
mus-sound-prunescale-selection-byzoom-focus-style
enved-style mus-sound-report-cachescale-selection-to
enved-target mus-sound-report-cachescale-selection-to
enved-targetmacro?mus-sound-sample-typescale-sound
enved-wave?macro?mus-sound-sample-typescale-sound
enved-wave?macroexpandmus-sound-samplesscale-tempo
diff -pruN 19-1/libgtk_s7.c 19.0-1/libgtk_s7.c --- 19-1/libgtk_s7.c 2018-11-23 11:33:45.000000000 +0000 +++ 19.0-1/libgtk_s7.c 2018-10-29 15:32:26.000000000 +0000 @@ -48486,9 +48486,9 @@ static void define_structs(s7_scheme *sc static void define_functions(s7_scheme *sc) { s7_pointer s_boolean, s_integer, s_real, s_string, s_any, s_pair, s_float, s_gtk_enum_t, s_pair_false; - s7_pointer pl_gu, pl_pg, pl_gus, pl_pgi, pl_pgu, pl_gui, pl_guut, pl_pgbi, pl_guuut, pl_gurrsiu, pl_gussitu, pl_t, pl_bsu, pl_bsigb, pl_g, pl_buuusuug, pl_bu, pl_pb, pl_bur, pl_bug, pl_bus, pl_bui, pl_bub, pl_buui, pl_buus, pl_busu, pl_buub, pl_buig, pl_busib, pl_buuub, pl_buttu, pl_busgu, pl_buuui, pl_buuig, pl_buiuig, pl_buusib, pl_buuuub, pl_buurbr, pl_tts, pl_tti, pl_iit, pl_iiit, pl_tg, pl_b, pl_isigutttiiu, pl_si, pl_is, pl_bt, pl_tb, pl_isi, pl_bti, pl_sig, pl_isgt, pl_btiib, pl_iu, pl_pi, pl_iur, pl_iug, pl_iui, pl_ius, pl_piu, pl_pit, pl_iuis, pl_iusi, pl_iuui, pl_iuuui, pl_iuisi, pl_iuuuui, pl_iuisut, pl_du, pl_pr, pl_dui, pl_dus, pl_dusi, pl_dusr, pl_i, pl_ssi, pl_ssig, pl_psgbiiiit, pl_psiiuusu, pl_su, pl_ps, pl_sui, pl_sug, pl_psi, pl_psb, pl_psu, pl_sus, pl_psg, pl_psgi, pl_psiu, pl_psut, pl_suuub, pl_psugt, pl_psiuub, pl_psrrrb, pl_ti, pl_pu, pl_it, pl_pur, pl_tiu, pl_pub, pl_pui, pl_pug, pl_pus, pl_put, pl_pugi, pl_pubi, pl_puri, pl_pust, pl_pusi, pl_pusu, pl_pugu, pl_puiu, pl_itsub, pl_puiig, pl_puigu, pl_pusiu, pl_pusub, pl_puuiu, pl_puiiu, pl_pussu, pl_puibu, pl_pusig, pl_itiiub, pl_puiigi, pl_pugiiu, pl_puuubu, pl_pusigu, pl_pusiiu, pl_puuiiu, pl_itstttg, pl_itgiiut, pl_pusiuiu, pl_puuusuug, pl_pusiuibu, pl_gi, pl_igi, pl_s, pl_p, pl_ts, pl_bi, pl_big, pl_tsi, pl_tsig, pl_tsiu, pl_tsiuui, pl_tsiiuui, pl_sg, pl_gs, pl_pt, pl_tu, pl_tut, pl_tus, pl_tug, pl_tur, pl_tui, pl_tub, pl_tusg, pl_tubi, pl_tugb, pl_tugs, pl_tuui, pl_tuib, pl_tusi, pl_tuug, pl_tuig, pl_tuur, pl_turi, pl_tusr, pl_tusb, pl_tuub, pl_tuus, pl_tugu, pl_tugr, pl_tugi, pl_tusu, pl_tuut, pl_tugt, pl_tuis, pl_tust, pl_tuiu, pl_tuit, pl_tuuiu, pl_tuurb, pl_tuuti, pl_tuuri, pl_tuugi, pl_turgs, pl_tuisi, pl_tusri, pl_tuuut, pl_tuubr, pl_tuuub, pl_tuuir, pl_tuuui, pl_tuusi, pl_tuiiu, pl_tuiggu, pl_turrrb, pl_tuusit, pl_tuurbr, pl_tusiis, pl_tusuig, pl_tuuubr, pl_tuuiuui, pl_tubiiiu, pl_tusiuiui, pl_tuiiiiui, pl_tuuiiiirrrrg, pl_tuuiiiirrrrgi, pl_bpt; + s7_pointer pl_du, pl_pr, pl_dui, pl_dus, pl_dusi, pl_dusr, pl_g, pl_b, pl_t, pl_ssi, pl_ssig, pl_tg, pl_psgbiiiit, pl_psiiuusu, pl_su, pl_ps, pl_bt, pl_tb, pl_bti, pl_sui, pl_sug, pl_psi, pl_psb, pl_psu, pl_sus, pl_psg, pl_psgi, pl_psiu, pl_psut, pl_btiib, pl_suuub, pl_psugt, pl_psiuub, pl_psrrrb, pl_pu, pl_pur, pl_tts, pl_tti, pl_pub, pl_pui, pl_pug, pl_pus, pl_put, pl_pugi, pl_pubi, pl_puri, pl_pust, pl_pusi, pl_pusu, pl_pugu, pl_puiu, pl_puiig, pl_puigu, pl_pusiu, pl_pusub, pl_puuiu, pl_puiiu, pl_pussu, pl_puibu, pl_pusig, pl_puiigi, pl_pugiiu, pl_puuubu, pl_pusigu, pl_pusiiu, pl_puuiiu, pl_pusiuiu, pl_puuusuug, pl_pusiuibu, pl_i, pl_gi, pl_igi, pl_bi, pl_big, pl_ti, pl_it, pl_tiu, pl_itsub, pl_itiiub, pl_itstttg, pl_itgiiut, pl_s, pl_p, pl_sg, pl_gs, pl_bsu, pl_bsigb, pl_gu, pl_pg, pl_gus, pl_pgi, pl_pgu, pl_gui, pl_guut, pl_pgbi, pl_guuut, pl_gurrsiu, pl_gussitu, pl_buuusuug, pl_bu, pl_pb, pl_ts, pl_bur, pl_bug, pl_bus, pl_bui, pl_tsi, pl_bub, pl_tsig, pl_buui, pl_buus, pl_busu, pl_buub, pl_tsiu, pl_buig, pl_busib, pl_buuub, pl_buttu, pl_busgu, pl_buuui, pl_buuig, pl_buiuig, pl_buusib, pl_buuuub, pl_buurbr, pl_tsiuui, pl_tsiiuui, pl_pt, pl_tu, pl_tut, pl_tus, pl_tug, pl_tur, pl_tui, pl_tub, pl_iit, pl_tusg, pl_tubi, pl_tugb, pl_tugs, pl_tuui, pl_tuib, pl_tusi, pl_tuug, pl_tuig, pl_iiit, pl_tuur, pl_turi, pl_tusr, pl_tusb, pl_tuub, pl_tuus, pl_tugu, pl_tugr, pl_tugi, pl_tusu, pl_tuut, pl_tugt, pl_tuis, pl_tust, pl_tuiu, pl_tuit, pl_tuuiu, pl_tuurb, pl_tuuti, pl_tuuri, pl_tuugi, pl_turgs, pl_tuisi, pl_tusri, pl_tuuut, pl_tuubr, pl_tuuub, pl_tuuir, pl_tuuui, pl_tuusi, pl_tuiiu, pl_tuiggu, pl_turrrb, pl_tuusit, pl_tuurbr, pl_tusiis, pl_tusuig, pl_tuuubr, pl_tuuiuui, pl_tubiiiu, pl_tusiuiui, pl_tuiiiiui, pl_tuuiiiirrrrg, pl_tuuiiiirrrrgi, pl_isigutttiiu, pl_si, pl_is, pl_isi, pl_sig, pl_isgt, pl_iu, pl_pi, pl_iur, pl_iug, pl_iui, pl_ius, pl_piu, pl_pit, pl_iuis, pl_iusi, pl_iuui, pl_iuuui, pl_iuisi, pl_iuuuui, pl_iuisut, pl_bpt; #if GTK_CHECK_VERSION(3, 0, 0) - s7_pointer pl_pgr, pl_gug, pl_buigu, pl_puuig, pl_puiiui, pl_tuuugi, pl_tuuuub; + s7_pointer pl_puuig, pl_puiiui, pl_pgr, pl_gug, pl_buigu, pl_tuuugi, pl_tuuuub; #endif #if GTK_CHECK_VERSION(3, 4, 0) @@ -48508,7 +48508,7 @@ static void define_functions(s7_scheme * #endif #if GTK_CHECK_VERSION(3, 22, 0) - s7_pointer pl_iugi, pl_tussu, pl_tuuggu, pl_tugiis; + s7_pointer pl_tussu, pl_tuuggu, pl_tugiis, pl_iugi; #endif #if GTK_CHECK_VERSION(3, 92, 0) @@ -48516,7 +48516,7 @@ static void define_functions(s7_scheme * #endif #if GTK_CHECK_VERSION(3, 99, 0) - s7_pointer pl_guugbuut, pl_but, pl_busi, pl_buib, pl_bugu, pl_iuugs, pl_piigui, pl_pst, pl_tist, pl_puuugi, pl_puiiit, pl_pusiiugu, pl_tsit, pl_turs, pl_tuiut, pl_tuuur, pl_tugug, pl_tugui, pl_turru, pl_tuuiut, pl_tutisi, pl_tuiiut, pl_tubbbt, pl_tusuiut, pl_tusiiut, pl_tuuuggu, pl_turrrru; + s7_pointer pl_pst, pl_puuugi, pl_puiiit, pl_pusiiugu, pl_tist, pl_guugbuut, pl_but, pl_tsit, pl_busi, pl_buib, pl_bugu, pl_turs, pl_tuiut, pl_tuuur, pl_tugug, pl_tugui, pl_turru, pl_tuuiut, pl_tutisi, pl_tuiiut, pl_tubbbt, pl_tusuiut, pl_tusiiut, pl_tuuuggu, pl_turrrru, pl_iuugs, pl_piigui; #endif @@ -48530,88 +48530,25 @@ static void define_functions(s7_scheme * s_gtk_enum_t = s7_make_symbol(sc, "gtk_enum_t?"); s_any = s7_t(sc); - pl_gu = s7_make_circular_signature(sc, 1, 2, s_gtk_enum_t, s_pair_false); - pl_pg = s7_make_circular_signature(sc, 1, 2, s_pair, s_gtk_enum_t); - pl_gus = s7_make_circular_signature(sc, 2, 3, s_gtk_enum_t, s_pair_false, s_string); - pl_pgi = s7_make_circular_signature(sc, 2, 3, s_pair, s_gtk_enum_t, s_integer); - pl_pgu = s7_make_circular_signature(sc, 2, 3, s_pair, s_gtk_enum_t, s_pair_false); - pl_gui = s7_make_circular_signature(sc, 2, 3, s_gtk_enum_t, s_pair_false, s_integer); - pl_guut = s7_make_circular_signature(sc, 3, 4, s_gtk_enum_t, s_pair_false, s_pair_false, s_any); - pl_pgbi = s7_make_circular_signature(sc, 3, 4, s_pair, s_gtk_enum_t, s_boolean, s_integer); - pl_guuut = s7_make_circular_signature(sc, 4, 5, s_gtk_enum_t, s_pair_false, s_pair_false, s_pair_false, s_any); - pl_gurrsiu = s7_make_circular_signature(sc, 6, 7, s_gtk_enum_t, s_pair_false, s_real, s_real, s_string, s_integer, s_pair_false); - pl_gussitu = s7_make_circular_signature(sc, 6, 7, s_gtk_enum_t, s_pair_false, s_string, s_string, s_integer, s_any, s_pair_false); - pl_t = s7_make_circular_signature(sc, 0, 1, s_any); - pl_bsu = s7_make_circular_signature(sc, 2, 3, s_boolean, s_string, s_pair_false); - pl_bsigb = s7_make_circular_signature(sc, 4, 5, s_boolean, s_string, s_integer, s_gtk_enum_t, s_boolean); - pl_g = s7_make_circular_signature(sc, 0, 1, s_gtk_enum_t); - pl_buuusuug = s7_make_circular_signature(sc, 7, 8, s_boolean, s_pair_false, s_pair_false, s_pair_false, s_string, s_pair_false, s_pair_false, s_gtk_enum_t); - pl_bu = s7_make_circular_signature(sc, 1, 2, s_boolean, s_pair_false); - pl_pb = s7_make_circular_signature(sc, 1, 2, s_pair, s_boolean); - pl_bur = s7_make_circular_signature(sc, 2, 3, s_boolean, s_pair_false, s_real); - pl_bug = s7_make_circular_signature(sc, 2, 3, s_boolean, s_pair_false, s_gtk_enum_t); - pl_bus = s7_make_circular_signature(sc, 2, 3, s_boolean, s_pair_false, s_string); - pl_bui = s7_make_circular_signature(sc, 2, 3, s_boolean, s_pair_false, s_integer); - pl_bub = s7_make_circular_signature(sc, 2, 3, s_boolean, s_pair_false, s_boolean); - pl_buui = s7_make_circular_signature(sc, 3, 4, s_boolean, s_pair_false, s_pair_false, s_integer); - pl_buus = s7_make_circular_signature(sc, 3, 4, s_boolean, s_pair_false, s_pair_false, s_string); - pl_busu = s7_make_circular_signature(sc, 3, 4, s_boolean, s_pair_false, s_string, s_pair_false); - pl_buub = s7_make_circular_signature(sc, 3, 4, s_boolean, s_pair_false, s_pair_false, s_boolean); - pl_buig = s7_make_circular_signature(sc, 3, 4, s_boolean, s_pair_false, s_integer, s_gtk_enum_t); - pl_busib = s7_make_circular_signature(sc, 4, 5, s_boolean, s_pair_false, s_string, s_integer, s_boolean); - pl_buuub = s7_make_circular_signature(sc, 4, 5, s_boolean, s_pair_false, s_pair_false, s_pair_false, s_boolean); - pl_buttu = s7_make_circular_signature(sc, 4, 5, s_boolean, s_pair_false, s_any, s_any, s_pair_false); - pl_busgu = s7_make_circular_signature(sc, 4, 5, s_boolean, s_pair_false, s_string, s_gtk_enum_t, s_pair_false); - pl_buuui = s7_make_circular_signature(sc, 4, 5, s_boolean, s_pair_false, s_pair_false, s_pair_false, s_integer); - pl_buuig = s7_make_circular_signature(sc, 4, 5, s_boolean, s_pair_false, s_pair_false, s_integer, s_gtk_enum_t); - pl_buiuig = s7_make_circular_signature(sc, 5, 6, s_boolean, s_pair_false, s_integer, s_pair_false, s_integer, s_gtk_enum_t); - pl_buusib = s7_make_circular_signature(sc, 5, 6, s_boolean, s_pair_false, s_pair_false, s_string, s_integer, s_boolean); - pl_buuuub = s7_make_circular_signature(sc, 5, 6, s_boolean, s_pair_false, s_pair_false, s_pair_false, s_pair_false, s_boolean); - pl_buurbr = s7_make_circular_signature(sc, 5, 6, s_boolean, s_pair_false, s_pair_false, s_real, s_boolean, s_real); - pl_tts = s7_make_circular_signature(sc, 2, 3, s_any, s_any, s_string); - pl_tti = s7_make_circular_signature(sc, 2, 3, s_any, s_any, s_integer); - pl_iit = s7_make_circular_signature(sc, 2, 3, s_integer, s_integer, s_any); - pl_iiit = s7_make_circular_signature(sc, 3, 4, s_integer, s_integer, s_integer, s_any); - pl_tg = s7_make_circular_signature(sc, 1, 2, s_any, s_gtk_enum_t); - pl_b = s7_make_circular_signature(sc, 0, 1, s_boolean); - pl_isigutttiiu = s7_make_circular_signature(sc, 10, 11, s_integer, s_string, s_integer, s_gtk_enum_t, s_pair_false, s_any, s_any, s_any, s_integer, s_integer, s_pair_false); - pl_si = s7_make_circular_signature(sc, 1, 2, s_string, s_integer); - pl_is = s7_make_circular_signature(sc, 1, 2, s_integer, s_string); - pl_bt = s7_make_circular_signature(sc, 1, 2, s_boolean, s_any); - pl_tb = s7_make_circular_signature(sc, 1, 2, s_any, s_boolean); - pl_isi = s7_make_circular_signature(sc, 2, 3, s_integer, s_string, s_integer); - pl_bti = s7_make_circular_signature(sc, 2, 3, s_boolean, s_any, s_integer); - pl_sig = s7_make_circular_signature(sc, 2, 3, s_string, s_integer, s_gtk_enum_t); - pl_isgt = s7_make_circular_signature(sc, 3, 4, s_integer, s_string, s_gtk_enum_t, s_any); - pl_btiib = s7_make_circular_signature(sc, 4, 5, s_boolean, s_any, s_integer, s_integer, s_boolean); - pl_iu = s7_make_circular_signature(sc, 1, 2, s_integer, s_pair_false); - pl_pi = s7_make_circular_signature(sc, 1, 2, s_pair, s_integer); - pl_iur = s7_make_circular_signature(sc, 2, 3, s_integer, s_pair_false, s_real); - pl_iug = s7_make_circular_signature(sc, 2, 3, s_integer, s_pair_false, s_gtk_enum_t); - pl_iui = s7_make_circular_signature(sc, 2, 3, s_integer, s_pair_false, s_integer); - pl_ius = s7_make_circular_signature(sc, 2, 3, s_integer, s_pair_false, s_string); - pl_piu = s7_make_circular_signature(sc, 2, 3, s_pair, s_integer, s_pair_false); - pl_pit = s7_make_circular_signature(sc, 2, 3, s_pair, s_integer, s_any); - pl_iuis = s7_make_circular_signature(sc, 3, 4, s_integer, s_pair_false, s_integer, s_string); - pl_iusi = s7_make_circular_signature(sc, 3, 4, s_integer, s_pair_false, s_string, s_integer); - pl_iuui = s7_make_circular_signature(sc, 3, 4, s_integer, s_pair_false, s_pair_false, s_integer); - pl_iuuui = s7_make_circular_signature(sc, 4, 5, s_integer, s_pair_false, s_pair_false, s_pair_false, s_integer); - pl_iuisi = s7_make_circular_signature(sc, 4, 5, s_integer, s_pair_false, s_integer, s_string, s_integer); - pl_iuuuui = s7_make_circular_signature(sc, 5, 6, s_integer, s_pair_false, s_pair_false, s_pair_false, s_pair_false, s_integer); - pl_iuisut = s7_make_circular_signature(sc, 5, 6, s_integer, s_pair_false, s_integer, s_string, s_pair_false, s_any); pl_du = s7_make_circular_signature(sc, 1, 2, s_float, s_pair_false); pl_pr = s7_make_circular_signature(sc, 1, 2, s_pair, s_real); pl_dui = s7_make_circular_signature(sc, 2, 3, s_float, s_pair_false, s_integer); pl_dus = s7_make_circular_signature(sc, 2, 3, s_float, s_pair_false, s_string); pl_dusi = s7_make_circular_signature(sc, 3, 4, s_float, s_pair_false, s_string, s_integer); pl_dusr = s7_make_circular_signature(sc, 3, 4, s_float, s_pair_false, s_string, s_real); - pl_i = s7_make_circular_signature(sc, 0, 1, s_integer); + pl_g = s7_make_circular_signature(sc, 0, 1, s_gtk_enum_t); + pl_b = s7_make_circular_signature(sc, 0, 1, s_boolean); + pl_t = s7_make_circular_signature(sc, 0, 1, s_any); pl_ssi = s7_make_circular_signature(sc, 2, 3, s_string, s_string, s_integer); pl_ssig = s7_make_circular_signature(sc, 3, 4, s_string, s_string, s_integer, s_gtk_enum_t); + pl_tg = s7_make_circular_signature(sc, 1, 2, s_any, s_gtk_enum_t); pl_psgbiiiit = s7_make_circular_signature(sc, 8, 9, s_pair, s_string, s_gtk_enum_t, s_boolean, s_integer, s_integer, s_integer, s_integer, s_any); pl_psiiuusu = s7_make_circular_signature(sc, 7, 8, s_pair, s_string, s_integer, s_integer, s_pair_false, s_pair_false, s_string, s_pair_false); pl_su = s7_make_circular_signature(sc, 1, 2, s_string, s_pair_false); pl_ps = s7_make_circular_signature(sc, 1, 2, s_pair, s_string); + pl_bt = s7_make_circular_signature(sc, 1, 2, s_boolean, s_any); + pl_tb = s7_make_circular_signature(sc, 1, 2, s_any, s_boolean); + pl_bti = s7_make_circular_signature(sc, 2, 3, s_boolean, s_any, s_integer); pl_sui = s7_make_circular_signature(sc, 2, 3, s_string, s_pair_false, s_integer); pl_sug = s7_make_circular_signature(sc, 2, 3, s_string, s_pair_false, s_gtk_enum_t); pl_psi = s7_make_circular_signature(sc, 2, 3, s_pair, s_string, s_integer); @@ -48622,15 +48559,15 @@ static void define_functions(s7_scheme * pl_psgi = s7_make_circular_signature(sc, 3, 4, s_pair, s_string, s_gtk_enum_t, s_integer); pl_psiu = s7_make_circular_signature(sc, 3, 4, s_pair, s_string, s_integer, s_pair_false); pl_psut = s7_make_circular_signature(sc, 3, 4, s_pair, s_string, s_pair_false, s_any); + pl_btiib = s7_make_circular_signature(sc, 4, 5, s_boolean, s_any, s_integer, s_integer, s_boolean); pl_suuub = s7_make_circular_signature(sc, 4, 5, s_string, s_pair_false, s_pair_false, s_pair_false, s_boolean); pl_psugt = s7_make_circular_signature(sc, 4, 5, s_pair, s_string, s_pair_false, s_gtk_enum_t, s_any); pl_psiuub = s7_make_circular_signature(sc, 5, 6, s_pair, s_string, s_integer, s_pair_false, s_pair_false, s_boolean); pl_psrrrb = s7_make_circular_signature(sc, 5, 6, s_pair, s_string, s_real, s_real, s_real, s_boolean); - pl_ti = s7_make_circular_signature(sc, 1, 2, s_any, s_integer); pl_pu = s7_make_circular_signature(sc, 1, 2, s_pair, s_pair_false); - pl_it = s7_make_circular_signature(sc, 1, 2, s_integer, s_any); pl_pur = s7_make_circular_signature(sc, 2, 3, s_pair, s_pair_false, s_real); - pl_tiu = s7_make_circular_signature(sc, 2, 3, s_any, s_integer, s_pair_false); + pl_tts = s7_make_circular_signature(sc, 2, 3, s_any, s_any, s_string); + pl_tti = s7_make_circular_signature(sc, 2, 3, s_any, s_any, s_integer); pl_pub = s7_make_circular_signature(sc, 2, 3, s_pair, s_pair_false, s_boolean); pl_pui = s7_make_circular_signature(sc, 2, 3, s_pair, s_pair_false, s_integer); pl_pug = s7_make_circular_signature(sc, 2, 3, s_pair, s_pair_false, s_gtk_enum_t); @@ -48644,7 +48581,6 @@ static void define_functions(s7_scheme * pl_pusu = s7_make_circular_signature(sc, 3, 4, s_pair, s_pair_false, s_string, s_pair_false); pl_pugu = s7_make_circular_signature(sc, 3, 4, s_pair, s_pair_false, s_gtk_enum_t, s_pair_false); pl_puiu = s7_make_circular_signature(sc, 3, 4, s_pair, s_pair_false, s_integer, s_pair_false); - pl_itsub = s7_make_circular_signature(sc, 4, 5, s_integer, s_any, s_string, s_pair_false, s_boolean); pl_puiig = s7_make_circular_signature(sc, 4, 5, s_pair, s_pair_false, s_integer, s_integer, s_gtk_enum_t); pl_puigu = s7_make_circular_signature(sc, 4, 5, s_pair, s_pair_false, s_integer, s_gtk_enum_t, s_pair_false); pl_pusiu = s7_make_circular_signature(sc, 4, 5, s_pair, s_pair_false, s_string, s_integer, s_pair_false); @@ -48654,32 +48590,73 @@ static void define_functions(s7_scheme * pl_pussu = s7_make_circular_signature(sc, 4, 5, s_pair, s_pair_false, s_string, s_string, s_pair_false); pl_puibu = s7_make_circular_signature(sc, 4, 5, s_pair, s_pair_false, s_integer, s_boolean, s_pair_false); pl_pusig = s7_make_circular_signature(sc, 4, 5, s_pair, s_pair_false, s_string, s_integer, s_gtk_enum_t); - pl_itiiub = s7_make_circular_signature(sc, 5, 6, s_integer, s_any, s_integer, s_integer, s_pair_false, s_boolean); pl_puiigi = s7_make_circular_signature(sc, 5, 6, s_pair, s_pair_false, s_integer, s_integer, s_gtk_enum_t, s_integer); pl_pugiiu = s7_make_circular_signature(sc, 5, 6, s_pair, s_pair_false, s_gtk_enum_t, s_integer, s_integer, s_pair_false); pl_puuubu = s7_make_circular_signature(sc, 5, 6, s_pair, s_pair_false, s_pair_false, s_pair_false, s_boolean, s_pair_false); pl_pusigu = s7_make_circular_signature(sc, 5, 6, s_pair, s_pair_false, s_string, s_integer, s_gtk_enum_t, s_pair_false); pl_pusiiu = s7_make_circular_signature(sc, 5, 6, s_pair, s_pair_false, s_string, s_integer, s_integer, s_pair_false); pl_puuiiu = s7_make_circular_signature(sc, 5, 6, s_pair, s_pair_false, s_pair_false, s_integer, s_integer, s_pair_false); - pl_itstttg = s7_make_circular_signature(sc, 6, 7, s_integer, s_any, s_string, s_any, s_any, s_any, s_gtk_enum_t); - pl_itgiiut = s7_make_circular_signature(sc, 6, 7, s_integer, s_any, s_gtk_enum_t, s_integer, s_integer, s_pair_false, s_any); pl_pusiuiu = s7_make_circular_signature(sc, 6, 7, s_pair, s_pair_false, s_string, s_integer, s_pair_false, s_integer, s_pair_false); pl_puuusuug = s7_make_circular_signature(sc, 7, 8, s_pair, s_pair_false, s_pair_false, s_pair_false, s_string, s_pair_false, s_pair_false, s_gtk_enum_t); pl_pusiuibu = s7_make_circular_signature(sc, 7, 8, s_pair, s_pair_false, s_string, s_integer, s_pair_false, s_integer, s_boolean, s_pair_false); + pl_i = s7_make_circular_signature(sc, 0, 1, s_integer); pl_gi = s7_make_circular_signature(sc, 1, 2, s_gtk_enum_t, s_integer); pl_igi = s7_make_circular_signature(sc, 2, 3, s_integer, s_gtk_enum_t, s_integer); + pl_bi = s7_make_circular_signature(sc, 1, 2, s_boolean, s_integer); + pl_big = s7_make_circular_signature(sc, 2, 3, s_boolean, s_integer, s_gtk_enum_t); + pl_ti = s7_make_circular_signature(sc, 1, 2, s_any, s_integer); + pl_it = s7_make_circular_signature(sc, 1, 2, s_integer, s_any); + pl_tiu = s7_make_circular_signature(sc, 2, 3, s_any, s_integer, s_pair_false); + pl_itsub = s7_make_circular_signature(sc, 4, 5, s_integer, s_any, s_string, s_pair_false, s_boolean); + pl_itiiub = s7_make_circular_signature(sc, 5, 6, s_integer, s_any, s_integer, s_integer, s_pair_false, s_boolean); + pl_itstttg = s7_make_circular_signature(sc, 6, 7, s_integer, s_any, s_string, s_any, s_any, s_any, s_gtk_enum_t); + pl_itgiiut = s7_make_circular_signature(sc, 6, 7, s_integer, s_any, s_gtk_enum_t, s_integer, s_integer, s_pair_false, s_any); pl_s = s7_make_circular_signature(sc, 0, 1, s_string); pl_p = s7_make_circular_signature(sc, 0, 1, s_pair); + pl_sg = s7_make_circular_signature(sc, 1, 2, s_string, s_gtk_enum_t); + pl_gs = s7_make_circular_signature(sc, 1, 2, s_gtk_enum_t, s_string); + pl_bsu = s7_make_circular_signature(sc, 2, 3, s_boolean, s_string, s_pair_false); + pl_bsigb = s7_make_circular_signature(sc, 4, 5, s_boolean, s_string, s_integer, s_gtk_enum_t, s_boolean); + pl_gu = s7_make_circular_signature(sc, 1, 2, s_gtk_enum_t, s_pair_false); + pl_pg = s7_make_circular_signature(sc, 1, 2, s_pair, s_gtk_enum_t); + pl_gus = s7_make_circular_signature(sc, 2, 3, s_gtk_enum_t, s_pair_false, s_string); + pl_pgi = s7_make_circular_signature(sc, 2, 3, s_pair, s_gtk_enum_t, s_integer); + pl_pgu = s7_make_circular_signature(sc, 2, 3, s_pair, s_gtk_enum_t, s_pair_false); + pl_gui = s7_make_circular_signature(sc, 2, 3, s_gtk_enum_t, s_pair_false, s_integer); + pl_guut = s7_make_circular_signature(sc, 3, 4, s_gtk_enum_t, s_pair_false, s_pair_false, s_any); + pl_pgbi = s7_make_circular_signature(sc, 3, 4, s_pair, s_gtk_enum_t, s_boolean, s_integer); + pl_guuut = s7_make_circular_signature(sc, 4, 5, s_gtk_enum_t, s_pair_false, s_pair_false, s_pair_false, s_any); + pl_gurrsiu = s7_make_circular_signature(sc, 6, 7, s_gtk_enum_t, s_pair_false, s_real, s_real, s_string, s_integer, s_pair_false); + pl_gussitu = s7_make_circular_signature(sc, 6, 7, s_gtk_enum_t, s_pair_false, s_string, s_string, s_integer, s_any, s_pair_false); + pl_buuusuug = s7_make_circular_signature(sc, 7, 8, s_boolean, s_pair_false, s_pair_false, s_pair_false, s_string, s_pair_false, s_pair_false, s_gtk_enum_t); + pl_bu = s7_make_circular_signature(sc, 1, 2, s_boolean, s_pair_false); + pl_pb = s7_make_circular_signature(sc, 1, 2, s_pair, s_boolean); pl_ts = s7_make_circular_signature(sc, 1, 2, s_any, s_string); - pl_bi = s7_make_circular_signature(sc, 1, 2, s_boolean, s_integer); - pl_big = s7_make_circular_signature(sc, 2, 3, s_boolean, s_integer, s_gtk_enum_t); + pl_bur = s7_make_circular_signature(sc, 2, 3, s_boolean, s_pair_false, s_real); + pl_bug = s7_make_circular_signature(sc, 2, 3, s_boolean, s_pair_false, s_gtk_enum_t); + pl_bus = s7_make_circular_signature(sc, 2, 3, s_boolean, s_pair_false, s_string); + pl_bui = s7_make_circular_signature(sc, 2, 3, s_boolean, s_pair_false, s_integer); pl_tsi = s7_make_circular_signature(sc, 2, 3, s_any, s_string, s_integer); + pl_bub = s7_make_circular_signature(sc, 2, 3, s_boolean, s_pair_false, s_boolean); pl_tsig = s7_make_circular_signature(sc, 3, 4, s_any, s_string, s_integer, s_gtk_enum_t); + pl_buui = s7_make_circular_signature(sc, 3, 4, s_boolean, s_pair_false, s_pair_false, s_integer); + pl_buus = s7_make_circular_signature(sc, 3, 4, s_boolean, s_pair_false, s_pair_false, s_string); + pl_busu = s7_make_circular_signature(sc, 3, 4, s_boolean, s_pair_false, s_string, s_pair_false); + pl_buub = s7_make_circular_signature(sc, 3, 4, s_boolean, s_pair_false, s_pair_false, s_boolean); pl_tsiu = s7_make_circular_signature(sc, 3, 4, s_any, s_string, s_integer, s_pair_false); + pl_buig = s7_make_circular_signature(sc, 3, 4, s_boolean, s_pair_false, s_integer, s_gtk_enum_t); + pl_busib = s7_make_circular_signature(sc, 4, 5, s_boolean, s_pair_false, s_string, s_integer, s_boolean); + pl_buuub = s7_make_circular_signature(sc, 4, 5, s_boolean, s_pair_false, s_pair_false, s_pair_false, s_boolean); + pl_buttu = s7_make_circular_signature(sc, 4, 5, s_boolean, s_pair_false, s_any, s_any, s_pair_false); + pl_busgu = s7_make_circular_signature(sc, 4, 5, s_boolean, s_pair_false, s_string, s_gtk_enum_t, s_pair_false); + pl_buuui = s7_make_circular_signature(sc, 4, 5, s_boolean, s_pair_false, s_pair_false, s_pair_false, s_integer); + pl_buuig = s7_make_circular_signature(sc, 4, 5, s_boolean, s_pair_false, s_pair_false, s_integer, s_gtk_enum_t); + pl_buiuig = s7_make_circular_signature(sc, 5, 6, s_boolean, s_pair_false, s_integer, s_pair_false, s_integer, s_gtk_enum_t); + pl_buusib = s7_make_circular_signature(sc, 5, 6, s_boolean, s_pair_false, s_pair_false, s_string, s_integer, s_boolean); + pl_buuuub = s7_make_circular_signature(sc, 5, 6, s_boolean, s_pair_false, s_pair_false, s_pair_false, s_pair_false, s_boolean); + pl_buurbr = s7_make_circular_signature(sc, 5, 6, s_boolean, s_pair_false, s_pair_false, s_real, s_boolean, s_real); pl_tsiuui = s7_make_circular_signature(sc, 5, 6, s_any, s_string, s_integer, s_pair_false, s_pair_false, s_integer); pl_tsiiuui = s7_make_circular_signature(sc, 6, 7, s_any, s_string, s_integer, s_integer, s_pair_false, s_pair_false, s_integer); - pl_sg = s7_make_circular_signature(sc, 1, 2, s_string, s_gtk_enum_t); - pl_gs = s7_make_circular_signature(sc, 1, 2, s_gtk_enum_t, s_string); pl_pt = s7_make_circular_signature(sc, 1, 2, s_pair, s_any); pl_tu = s7_make_circular_signature(sc, 1, 2, s_any, s_pair_false); pl_tut = s7_make_circular_signature(sc, 2, 3, s_any, s_pair_false, s_any); @@ -48688,6 +48665,7 @@ static void define_functions(s7_scheme * pl_tur = s7_make_circular_signature(sc, 2, 3, s_any, s_pair_false, s_real); pl_tui = s7_make_circular_signature(sc, 2, 3, s_any, s_pair_false, s_integer); pl_tub = s7_make_circular_signature(sc, 2, 3, s_any, s_pair_false, s_boolean); + pl_iit = s7_make_circular_signature(sc, 2, 3, s_integer, s_integer, s_any); pl_tusg = s7_make_circular_signature(sc, 3, 4, s_any, s_pair_false, s_string, s_gtk_enum_t); pl_tubi = s7_make_circular_signature(sc, 3, 4, s_any, s_pair_false, s_boolean, s_integer); pl_tugb = s7_make_circular_signature(sc, 3, 4, s_any, s_pair_false, s_gtk_enum_t, s_boolean); @@ -48697,6 +48675,7 @@ static void define_functions(s7_scheme * pl_tusi = s7_make_circular_signature(sc, 3, 4, s_any, s_pair_false, s_string, s_integer); pl_tuug = s7_make_circular_signature(sc, 3, 4, s_any, s_pair_false, s_pair_false, s_gtk_enum_t); pl_tuig = s7_make_circular_signature(sc, 3, 4, s_any, s_pair_false, s_integer, s_gtk_enum_t); + pl_iiit = s7_make_circular_signature(sc, 3, 4, s_integer, s_integer, s_integer, s_any); pl_tuur = s7_make_circular_signature(sc, 3, 4, s_any, s_pair_false, s_pair_false, s_real); pl_turi = s7_make_circular_signature(sc, 3, 4, s_any, s_pair_false, s_real, s_integer); pl_tusr = s7_make_circular_signature(sc, 3, 4, s_any, s_pair_false, s_string, s_real); @@ -48741,13 +48720,34 @@ static void define_functions(s7_scheme * pl_tuiiiiui = s7_make_circular_signature(sc, 7, 8, s_any, s_pair_false, s_integer, s_integer, s_integer, s_integer, s_pair_false, s_integer); pl_tuuiiiirrrrg = s7_make_circular_signature(sc, 11, 12, s_any, s_pair_false, s_pair_false, s_integer, s_integer, s_integer, s_integer, s_real, s_real, s_real, s_real, s_gtk_enum_t); pl_tuuiiiirrrrgi = s7_make_circular_signature(sc, 12, 13, s_any, s_pair_false, s_pair_false, s_integer, s_integer, s_integer, s_integer, s_real, s_real, s_real, s_real, s_gtk_enum_t, s_integer); + pl_isigutttiiu = s7_make_circular_signature(sc, 10, 11, s_integer, s_string, s_integer, s_gtk_enum_t, s_pair_false, s_any, s_any, s_any, s_integer, s_integer, s_pair_false); + pl_si = s7_make_circular_signature(sc, 1, 2, s_string, s_integer); + pl_is = s7_make_circular_signature(sc, 1, 2, s_integer, s_string); + pl_isi = s7_make_circular_signature(sc, 2, 3, s_integer, s_string, s_integer); + pl_sig = s7_make_circular_signature(sc, 2, 3, s_string, s_integer, s_gtk_enum_t); + pl_isgt = s7_make_circular_signature(sc, 3, 4, s_integer, s_string, s_gtk_enum_t, s_any); + pl_iu = s7_make_circular_signature(sc, 1, 2, s_integer, s_pair_false); + pl_pi = s7_make_circular_signature(sc, 1, 2, s_pair, s_integer); + pl_iur = s7_make_circular_signature(sc, 2, 3, s_integer, s_pair_false, s_real); + pl_iug = s7_make_circular_signature(sc, 2, 3, s_integer, s_pair_false, s_gtk_enum_t); + pl_iui = s7_make_circular_signature(sc, 2, 3, s_integer, s_pair_false, s_integer); + pl_ius = s7_make_circular_signature(sc, 2, 3, s_integer, s_pair_false, s_string); + pl_piu = s7_make_circular_signature(sc, 2, 3, s_pair, s_integer, s_pair_false); + pl_pit = s7_make_circular_signature(sc, 2, 3, s_pair, s_integer, s_any); + pl_iuis = s7_make_circular_signature(sc, 3, 4, s_integer, s_pair_false, s_integer, s_string); + pl_iusi = s7_make_circular_signature(sc, 3, 4, s_integer, s_pair_false, s_string, s_integer); + pl_iuui = s7_make_circular_signature(sc, 3, 4, s_integer, s_pair_false, s_pair_false, s_integer); + pl_iuuui = s7_make_circular_signature(sc, 4, 5, s_integer, s_pair_false, s_pair_false, s_pair_false, s_integer); + pl_iuisi = s7_make_circular_signature(sc, 4, 5, s_integer, s_pair_false, s_integer, s_string, s_integer); + pl_iuuuui = s7_make_circular_signature(sc, 5, 6, s_integer, s_pair_false, s_pair_false, s_pair_false, s_pair_false, s_integer); + pl_iuisut = s7_make_circular_signature(sc, 5, 6, s_integer, s_pair_false, s_integer, s_string, s_pair_false, s_any); pl_bpt = s7_make_signature(sc, 2, s_pair_false, s_any); #if GTK_CHECK_VERSION(3, 0, 0) + pl_puuig = s7_make_circular_signature(sc, 4, 5, s_pair, s_pair_false, s_pair_false, s_integer, s_gtk_enum_t); + pl_puiiui = s7_make_circular_signature(sc, 5, 6, s_pair, s_pair_false, s_integer, s_integer, s_pair_false, s_integer); pl_pgr = s7_make_circular_signature(sc, 2, 3, s_pair, s_gtk_enum_t, s_real); pl_gug = s7_make_circular_signature(sc, 2, 3, s_gtk_enum_t, s_pair_false, s_gtk_enum_t); pl_buigu = s7_make_circular_signature(sc, 4, 5, s_boolean, s_pair_false, s_integer, s_gtk_enum_t, s_pair_false); - pl_puuig = s7_make_circular_signature(sc, 4, 5, s_pair, s_pair_false, s_pair_false, s_integer, s_gtk_enum_t); - pl_puiiui = s7_make_circular_signature(sc, 5, 6, s_pair, s_pair_false, s_integer, s_integer, s_pair_false, s_integer); pl_tuuugi = s7_make_circular_signature(sc, 5, 6, s_any, s_pair_false, s_pair_false, s_pair_false, s_gtk_enum_t, s_integer); pl_tuuuub = s7_make_circular_signature(sc, 5, 6, s_any, s_pair_false, s_pair_false, s_pair_false, s_pair_false, s_boolean); #endif @@ -48776,10 +48776,10 @@ static void define_functions(s7_scheme * #endif #if GTK_CHECK_VERSION(3, 22, 0) - pl_iugi = s7_make_circular_signature(sc, 3, 4, s_integer, s_pair_false, s_gtk_enum_t, s_integer); pl_tussu = s7_make_circular_signature(sc, 4, 5, s_any, s_pair_false, s_string, s_string, s_pair_false); pl_tuuggu = s7_make_circular_signature(sc, 5, 6, s_any, s_pair_false, s_pair_false, s_gtk_enum_t, s_gtk_enum_t, s_pair_false); pl_tugiis = s7_make_circular_signature(sc, 5, 6, s_any, s_pair_false, s_gtk_enum_t, s_integer, s_integer, s_string); + pl_iugi = s7_make_circular_signature(sc, 3, 4, s_integer, s_pair_false, s_gtk_enum_t, s_integer); #endif #if GTK_CHECK_VERSION(3, 92, 0) @@ -48787,19 +48787,17 @@ static void define_functions(s7_scheme * #endif #if GTK_CHECK_VERSION(3, 99, 0) - pl_guugbuut = s7_make_circular_signature(sc, 7, 8, s_gtk_enum_t, s_pair_false, s_pair_false, s_gtk_enum_t, s_boolean, s_pair_false, s_pair_false, s_any); - pl_but = s7_make_circular_signature(sc, 2, 3, s_boolean, s_pair_false, s_any); - pl_busi = s7_make_circular_signature(sc, 3, 4, s_boolean, s_pair_false, s_string, s_integer); - pl_buib = s7_make_circular_signature(sc, 3, 4, s_boolean, s_pair_false, s_integer, s_boolean); - pl_bugu = s7_make_circular_signature(sc, 3, 4, s_boolean, s_pair_false, s_gtk_enum_t, s_pair_false); - pl_iuugs = s7_make_circular_signature(sc, 4, 5, s_integer, s_pair_false, s_pair_false, s_gtk_enum_t, s_string); - pl_piigui = s7_make_circular_signature(sc, 5, 6, s_pair, s_integer, s_integer, s_gtk_enum_t, s_pair_false, s_integer); pl_pst = s7_make_circular_signature(sc, 2, 3, s_pair, s_string, s_any); - pl_tist = s7_make_circular_signature(sc, 3, 4, s_any, s_integer, s_string, s_any); pl_puuugi = s7_make_circular_signature(sc, 5, 6, s_pair, s_pair_false, s_pair_false, s_pair_false, s_gtk_enum_t, s_integer); pl_puiiit = s7_make_circular_signature(sc, 5, 6, s_pair, s_pair_false, s_integer, s_integer, s_integer, s_any); pl_pusiiugu = s7_make_circular_signature(sc, 7, 8, s_pair, s_pair_false, s_string, s_integer, s_integer, s_pair_false, s_gtk_enum_t, s_pair_false); + pl_tist = s7_make_circular_signature(sc, 3, 4, s_any, s_integer, s_string, s_any); + pl_guugbuut = s7_make_circular_signature(sc, 7, 8, s_gtk_enum_t, s_pair_false, s_pair_false, s_gtk_enum_t, s_boolean, s_pair_false, s_pair_false, s_any); + pl_but = s7_make_circular_signature(sc, 2, 3, s_boolean, s_pair_false, s_any); pl_tsit = s7_make_circular_signature(sc, 3, 4, s_any, s_string, s_integer, s_any); + pl_busi = s7_make_circular_signature(sc, 3, 4, s_boolean, s_pair_false, s_string, s_integer); + pl_buib = s7_make_circular_signature(sc, 3, 4, s_boolean, s_pair_false, s_integer, s_boolean); + pl_bugu = s7_make_circular_signature(sc, 3, 4, s_boolean, s_pair_false, s_gtk_enum_t, s_pair_false); pl_turs = s7_make_circular_signature(sc, 3, 4, s_any, s_pair_false, s_real, s_string); pl_tuiut = s7_make_circular_signature(sc, 4, 5, s_any, s_pair_false, s_integer, s_pair_false, s_any); pl_tuuur = s7_make_circular_signature(sc, 4, 5, s_any, s_pair_false, s_pair_false, s_pair_false, s_real); @@ -48814,6 +48812,8 @@ static void define_functions(s7_scheme * pl_tusiiut = s7_make_circular_signature(sc, 6, 7, s_any, s_pair_false, s_string, s_integer, s_integer, s_pair_false, s_any); pl_tuuuggu = s7_make_circular_signature(sc, 6, 7, s_any, s_pair_false, s_pair_false, s_pair_false, s_gtk_enum_t, s_gtk_enum_t, s_pair_false); pl_turrrru = s7_make_circular_signature(sc, 6, 7, s_any, s_pair_false, s_real, s_real, s_real, s_real, s_pair_false); + pl_iuugs = s7_make_circular_signature(sc, 4, 5, s_integer, s_pair_false, s_pair_false, s_gtk_enum_t, s_string); + pl_piigui = s7_make_circular_signature(sc, 5, 6, s_pair, s_integer, s_integer, s_gtk_enum_t, s_pair_false, s_integer); #endif @@ -56019,7 +56019,7 @@ void libgtk_s7_init(s7_scheme *sc) define_functions(sc); s7_define_function(sc, "g_signal_connect", lg_g_signal_connect, 3, 1, 0, H_g_signal_connect); s7_set_shadow_rootlet(sc, old_shadow); - s7_define(sc, cur_env, s7_make_symbol(sc, "libgtk-version"), s7_make_string(sc, "16-Oct-18")); + s7_define(sc, cur_env, s7_make_symbol(sc, "libgtk-version"), s7_make_string(sc, "29-Oct-18")); } /* gcc -c libgtk_s7.c -o libgtk_s7.o -I. -fPIC `pkg-config --libs gtk+-3.0 --cflags` -lm -ldl */ /* gcc libgtk_s7.o -shared -o libgtk_s7.so */ diff -pruN 19-1/lint.scm 19.0-1/lint.scm --- 19-1/lint.scm 2018-11-23 11:33:45.000000000 +0000 +++ 19.0-1/lint.scm 2018-12-28 22:51:01.000000000 +0000 @@ -113,7 +113,7 @@ eof-object? eq? equal? eqv? even? exact->inexact exact? exp expt float? float-vector float-vector-ref float-vector? floor for-each funclet gcd gensym gensym? - hash-table hash-table* hash-table-entries hash-table-ref hash-table? help hook-functions + hash-table hash-table-entries hash-table-ref hash-table? help hook-functions if imag-part immutable? inexact->exact inexact? infinite? inlet input-port? int-vector int-vector-ref int-vector? iterator-at-end? iterator-sequence integer->char integer-decode-float integer-length integer? iterator? @@ -180,7 +180,7 @@ list->vector vector-fill! vector-length vector->list vector-ref vector-set! vector-dimensions make-vector subvector vector float-vector make-float-vector float-vector-set! float-vector-ref int-vector make-int-vector int-vector-set! int-vector-ref string->byte-vector - byte-vector make-byte-vector hash-table hash-table* make-hash-table hash-table-ref + byte-vector make-byte-vector hash-table make-hash-table hash-table-ref hash-table-set! hash-table-entries cyclic-sequences call/cc call-with-current-continuation call-with-exit load autoload eval eval-string apply for-each map dynamic-wind values catch throw error documentation signature help procedure-source funclet @@ -200,7 +200,7 @@ make-string string string-copy copy list->string string->list string-append substring object->string format cons list make-list reverse append vector-append list->vector vector->list make-vector subvector vector make-float-vector float-vector make-int-vector int-vector byte-vector - hash-table hash-table* make-hash-table make-hook list-values append gentemp)) ; gentemp for other schemes + hash-table make-hash-table make-hook list-values append gentemp)) ; gentemp for other schemes h)) (non-negative-ops (let ((h (make-hash-table))) @@ -310,10 +310,10 @@ define-values define-module define-method define-syntax define-public define-inlinable define-integrable define^)) - (cxars (hash-table '(car . ()) '(caar . car) '(cdar . cdr) - '(caaar . caar) '(cdaar . cdar) '(cddar . cddr) '(cadar . cadr) - '(caaaar . caaar) '(caadar . caadr) '(cadaar . cadar) '(caddar . caddr) - '(cdaaar . cdaar) '(cdadar . cdadr) '(cddaar . cddar) '(cdddar . cdddr))) + (cxars (hash-table 'car () 'caar 'car 'cdar 'cdr + 'caaar 'caar 'cdaar 'cdar 'cddar 'cddr 'cadar 'cadr + 'caaaar 'caaar 'caadar 'caadr 'cadaar 'cadar 'caddar 'caddr + 'cdaaar 'cdaar 'cdadar 'cdadr 'cddaar 'cddar 'cdddar 'cdddr)) (outport #t) (linted-files ()) @@ -372,16 +372,15 @@ (define target-line-length 80) ; also 120 via let-temporarily (denote (lint-truncate-string str) - (let ((len (length str))) - (if (< len target-line-length) - str - (do ((i (- target-line-length 6) (- i 1))) + (if (< (length str) target-line-length) + str + (do ((i (- target-line-length 6) (- i 1))) ((or (= i 40) (char-whitespace? (string-ref str i))) (string-append (substring str 0 (if (<= i 40) (- target-line-length 6) i)) - "...")))))) + "..."))))) (denote (truncated-list->string form) ;; return form -> string with limits on its length @@ -2197,7 +2196,7 @@ (lambda (caller vname) (set! sname (symbol->string vname)) ;(if (keyword? vname) (keyword->symbol vname) vname))) (set! slen (length sname)) - (set! s0 (sname 0)) + (set! s0 (string-ref sname 0)) (cond ((assq s0 bad-var-names) => (lambda (baddies) @@ -6179,16 +6178,16 @@ (list (reverse ci) (reverse ic))) |# (define match-cxr - (let ((int->cxr (hash-table '(1 . car) '(2 . cdr) - '(5 . caar) '(6 . cadr) '(10 . cddr) '(9 . cdar) - '(21 . caaar) '(22 . caadr) '(26 . caddr) '(42 . cdddr) '(37 . cdaar) '(41 . cddar) '(25 . cadar) '(38 . cdadr) - '(106 . cadddr) '(170 . cddddr) '(85 . caaaar) '(86 . caaadr) '(89 . caadar) '(90 . caaddr) '(101 . cadaar) '(102 . cadadr) - '(105 . caddar) '(149 . cdaaar) '(150 . cdaadr) '(153 . cdadar) '(154 . cdaddr) '(165 . cddaar) '(166 . cddadr) '(169 . cdddar))) - (cxr->int (hash-table '(car . 1) '(cdr . 2) - '(caar . 5) '(cadr . 6) '(cddr . 10) '(cdar . 9) - '(caaar . 21) '(caadr . 22) '(caddr . 26) '(cdddr . 42) '(cdaar . 37) '(cddar . 41) '(cadar . 25) '(cdadr . 38) - '(cadddr . 106) '(cddddr . 170) '(caaaar . 85) '(caaadr . 86) '(caadar . 89) '(caaddr . 90) '(cadaar . 101) '(cadadr . 102) - '(caddar . 105) '(cdaaar . 149) '(cdaadr . 150) '(cdadar . 153) '(cdaddr . 154) '(cddaar . 165) '(cddadr . 166) '(cdddar . 169)))) + (let ((int->cxr (hash-table 1 'car 2 'cdr + 5 'caar 6 'cadr 10 'cddr 9 'cdar + 21 'caaar 22 'caadr 26 'caddr 42 'cdddr 37 'cdaar 41 'cddar 25 'cadar 38 'cdadr + 106 'cadddr 170 'cddddr 85 'caaaar 86 'caaadr 89 'caadar 90 'caaddr 101 'cadaar 102 'cadadr + 105 'caddar 149 'cdaaar 150 'cdaadr 153 'cdadar 154 'cdaddr 165 'cddaar 166 'cddadr 169 'cdddar)) + (cxr->int (hash-table 'car 1 'cdr 2 + 'caar 5 'cadr 6 'cddr 10 'cdar 9 + 'caaar 21 'caadr 22 'caddr 26 'cdddr 42 'cdaar 37 'cddar 41 'cadar 25 'cdadr 38 + 'cadddr 106 'cddddr 170 'caaaar 85 'caaadr 86 'caadar 89 'caaddr 90 'cadaar 101 'cadadr 102 + 'caddar 105 'cdaaar 149 'cdaadr 150 'cdadar 153 'cdaddr 154 'cddaar 165 'cddadr 166 'cdddar 169))) (lambda (c1 c2) (hash-table-ref int->cxr (logand (or (hash-table-ref cxr->int c1) 0) (or (hash-table-ref cxr->int c2) 0)))))) @@ -7535,7 +7534,7 @@ (list seq1 (caddr seq) (caddr form)))))) (if (memq (car seq) '(make-vector make-list vector list make-float-vector make-int-vector float-vector int-vector - make-hash-table hash-table hash-table* + make-hash-table hash-table inlet)) (lint-format "this doesn't make much sense: ~A" caller form))) (when (eq? head 'list-ref) @@ -7599,7 +7598,7 @@ ((memq (car target) '(make-vector vector make-string string make-list list append cons vector-append inlet sublet copy vector-copy string-copy list-copy int-vector float-vector byte-vector string-append make-byte-vector - make-int-vector make-float-vector make-hash-table hash-table hash-table* + make-int-vector make-float-vector make-hash-table hash-table )) ;list-copy is from r7rs (lint-format "~A is simply discarded; perhaps ~A" caller (truncated-list->string target) ; (vector-set! (make-vector 3) 1 1) -- does this ever happen? @@ -9525,14 +9524,14 @@ (lint-format "perhaps use abs here: ~A" caller form))) (hash-special 'magnitude sp-magnitude)) - ;; ---------------- hash-table* ---------------- + ;; ---------------- hash-table ---------------- (let () - (define (sp-hash* caller head form env) + (define (sp-hash caller head form env) (let ((len (length form))) (if (and (positive? len) (even? len)) (lint-format "key with no value? ~A" caller (truncated-list->string form))))) - (hash-special 'hash-table* sp-hash*)) + (hash-special 'hash-table sp-hash)) ;; ---------------- open-input-file open-output-file ---------------- (let () @@ -11122,19 +11121,19 @@ (cons (car e1) lst))))) (denote report-usage - (let ((unwrap-cxr (hash-table '(caar car) '(cadr cdr) '(cddr cdr) '(cdar car) - '(caaar caar car) '(caadr cadr cdr) '(caddr cddr cdr) '(cdddr cddr cdr) - '(cdaar caar car) '(cddar cdar car) '(cadar cadr car) '(cdadr cadr cdr) - '(cadddr cdddr cddr cdr) '(cddddr cdddr cddr cdr) '(caaaar caaar caar car) '(caaadr caadr cadr cdr) - '(caadar cadar cdar car) '(caaddr caddr cddr cdr) '(cadaar cdaar caar car) '(cadadr cdadr cadr cdr) - '(caddar cddar cdar car) '(cdaaar caaar caar car) '(cdaadr caadr cadr cdr) '(cdadar cadar cdar car) - '(cdaddr caddr cddr cdr) '(cddaar cdaar caar car) '(cddadr cdadr cadr cdr) '(cdddar cddar cdar car))) + (let ((unwrap-cxr (hash-table 'caar '(car) 'cadr '(cdr) 'cddr '(cdr) 'cdar '(car) + 'caaar '(caar car) 'caadr '(cadr cdr) 'caddr '(cddr cdr) 'cdddr '(cddr cdr) + 'cdaar '(caar car) 'cddar '(cdar car) 'cadar '(cadr car) 'cdadr '(cadr cdr) + 'cadddr '(cdddr cddr cdr) 'cddddr '(cdddr cddr cdr) 'caaaar '(caaar caar car) 'caaadr '(caadr cadr cdr) + 'caadar '(cadar cdar car) 'caaddr '(caddr cddr cdr) 'cadaar '(cdaar caar car) 'cadadr '(cdadr cadr cdr) + 'caddar '(cddar cdar car) 'cdaaar '(caaar caar car) 'cdaadr '(caadr cadr cdr) 'cdadar '(cadar cdar car) + 'cdaddr '(caddr cddr cdr) 'cddaar '(cdaar caar car) 'cddadr '(cdadr cadr cdr) 'cdddar '(cddar cdar car))) (all-types-agree (lambda (v) (let ((base-type (->lint-type (var-initial-value v))) (vname (var-name v))) (let ((typef (lambda (p) (or (not (and (len>2? p) - (eq? (car p) 'set!) + (eq? (car p) 'set!) (eq? vname (cadr p)))) (let ((nt (->lint-type (caddr p)))) (or (subsumes? base-type nt) @@ -21429,7 +21428,7 @@ (else (set-outer outer-vars tree)))) - + (lambda (new-form leaves env fvar orig-form) (unless (tree-set-memq '(define define* ;; these propagate backwards and we're not returning the new env in this loop, @@ -21526,7 +21525,7 @@ ;; -------- walk head=symbol -------- (denote walk-symbol - (letrec ((unsafe-makers '(sublet inlet copy cons list append subvector vector hash-table hash-table* + (letrec ((unsafe-makers '(sublet inlet copy cons list append subvector vector hash-table make-hash-table make-hook list-values append gentemp or and not)) (equal-ignoring-constants? diff -pruN 19-1/mkinstalldirs 19.0-1/mkinstalldirs --- 19-1/mkinstalldirs 2018-11-23 11:33:45.000000000 +0000 +++ 19.0-1/mkinstalldirs 2017-10-17 17:18:43.000000000 +0000 @@ -1,40 +1,162 @@ #! /bin/sh # mkinstalldirs --- make directory hierarchy -# Author: Noah Friedman -# Created: 1993-05-16 -# Public domain -# $Id: mkinstalldirs,v 1.13 1999/01/05 03:18:55 bje Exp $ +scriptversion=2009-04-28.21; # UTC +# Original author: Noah Friedman +# Created: 1993-05-16 +# Public domain. +# +# This file is maintained in Automake, please report +# bugs to or send patches to +# . + +nl=' +' +IFS=" "" $nl" errstatus=0 +dirmode= + +usage="\ +Usage: mkinstalldirs [-h] [--help] [--version] [-m MODE] DIR ... + +Create each directory DIR (with mode MODE, if specified), including all +leading file name components. + +Report bugs to ." + +# process command line arguments +while test $# -gt 0 ; do + case $1 in + -h | --help | --h*) # -h for help + echo "$usage" + exit $? + ;; + -m) # -m PERM arg + shift + test $# -eq 0 && { echo "$usage" 1>&2; exit 1; } + dirmode=$1 + shift + ;; + --version) + echo "$0 $scriptversion" + exit $? + ;; + --) # stop option processing + shift + break + ;; + -*) # unknown option + echo "$usage" 1>&2 + exit 1 + ;; + *) # first non-opt arg + break + ;; + esac +done for file do - set fnord `echo ":$file" | sed -ne 's/^:\//#/;s/^://;s/\// /g;s/^#/\//;p'` - shift + if test -d "$file"; then + shift + else + break + fi +done + +case $# in + 0) exit 0 ;; +esac + +# Solaris 8's mkdir -p isn't thread-safe. If you mkdir -p a/b and +# mkdir -p a/c at the same time, both will detect that a is missing, +# one will create a, then the other will try to create a and die with +# a "File exists" error. This is a problem when calling mkinstalldirs +# from a parallel make. We use --version in the probe to restrict +# ourselves to GNU mkdir, which is thread-safe. +case $dirmode in + '') + if mkdir -p --version . >/dev/null 2>&1 && test ! -d ./--version; then + echo "mkdir -p -- $*" + exec mkdir -p -- "$@" + else + # On NextStep and OpenStep, the 'mkdir' command does not + # recognize any option. It will interpret all options as + # directories to create, and then abort because '.' already + # exists. + test -d ./-p && rmdir ./-p + test -d ./--version && rmdir ./--version + fi + ;; + *) + if mkdir -m "$dirmode" -p --version . >/dev/null 2>&1 && + test ! -d ./--version; then + echo "mkdir -m $dirmode -p -- $*" + exec mkdir -m "$dirmode" -p -- "$@" + else + # Clean up after NextStep and OpenStep mkdir. + for d in ./-m ./-p ./--version "./$dirmode"; + do + test -d $d && rmdir $d + done + fi + ;; +esac - pathcomp= - for d - do - pathcomp="$pathcomp$d" - case "$pathcomp" in - -* ) pathcomp=./$pathcomp ;; - esac - - if test ! -d "$pathcomp"; then - echo "mkdir $pathcomp" - - mkdir "$pathcomp" || lasterr=$? - - if test ! -d "$pathcomp"; then - errstatus=$lasterr - fi - fi +for file +do + case $file in + /*) pathcomp=/ ;; + *) pathcomp= ;; + esac + oIFS=$IFS + IFS=/ + set fnord $file + shift + IFS=$oIFS + + for d + do + test "x$d" = x && continue + + pathcomp=$pathcomp$d + case $pathcomp in + -*) pathcomp=./$pathcomp ;; + esac + + if test ! -d "$pathcomp"; then + echo "mkdir $pathcomp" + + mkdir "$pathcomp" || lasterr=$? + + if test ! -d "$pathcomp"; then + errstatus=$lasterr + else + if test ! -z "$dirmode"; then + echo "chmod $dirmode $pathcomp" + lasterr= + chmod "$dirmode" "$pathcomp" || lasterr=$? + + if test ! -z "$lasterr"; then + errstatus=$lasterr + fi + fi + fi + fi - pathcomp="$pathcomp/" - done + pathcomp=$pathcomp/ + done done exit $errstatus -# mkinstalldirs ends here +# Local Variables: +# mode: shell-script +# sh-indentation: 2 +# eval: (add-hook 'write-file-hooks 'time-stamp) +# time-stamp-start: "scriptversion=" +# time-stamp-format: "%:y-%02m-%02d.%02H" +# time-stamp-time-zone: "UTC" +# time-stamp-end: "; # UTC" +# End: diff -pruN 19-1/mockery.scm 19.0-1/mockery.scm --- 19-1/mockery.scm 2018-11-23 11:33:45.000000000 +0000 +++ 19.0-1/mockery.scm 2018-12-24 16:00:20.000000000 +0000 @@ -232,11 +232,6 @@ (set! (v 'value) (apply #_hash-table args)) v)) - (define (mock-hash-table* . args) - (let ((v (make-mock-hash-table))) - (set! (v 'value) (apply #_hash-table* args)) - v)) - (set! mock-hash-table? (lambda (obj) (and (openlet? obj) (outlet-member obj mock-hash-table-class)))) diff -pruN 19-1/NEWS 19.0-1/NEWS --- 19-1/NEWS 2018-11-23 11:33:45.000000000 +0000 +++ 19.0-1/NEWS 2019-01-01 12:51:44.000000000 +0000 @@ -1,12 +1,23 @@ -Snd 18.9: +Snd 19.0 -Kjetil updated the s7webserver directory +s7: added (*s7* 'history-enabled) at Kjetil's suggestion. + deprecated s7_gc_unprotect (use s7_gc_unprotect_at). + added weak-hash-table -s7: variables can be statically typed via the built-in type checkers like integer? - for example, (set! (setter 'x) integer?) +The main visible s7 change: -audio.c: added JACK_AUTO_SRC (defaults to 1). +hash-table* is now hash-table, and the old hash-table is gone. +This code can provide backwards compatibility except for some +corner cases involving map and for-each: -checked: FC 29 (gcc 8.2.1), macOS Mojave, sbcl 1.4.13 +(when (string>=? (s7-version) "8.0") + (define hash-table* hash-table) + (define (hash-table . args) + (apply hash-table* (map (lambda (x) + (values (car x) (cdr x))) + args)))) + + +checked: sbcl 1.4.14|15 Thanks!: Kjetil Matheussen \ No newline at end of file diff -pruN 19-1/peak-phases.scm 19.0-1/peak-phases.scm --- 19-1/peak-phases.scm 2018-11-23 11:33:45.000000000 +0000 +++ 19.0-1/peak-phases.scm 2019-01-01 12:51:44.000000000 +0000 @@ -3040,21 +3040,21 @@ (vector 100 15.637986183167 #r(0 1 0 1 0 0 0 0 1 1 0 1 1 0 0 1 0 1 0 1 1 0 1 0 1 0 1 0 0 1 0 0 0 1 0 1 1 1 1 1 0 0 1 0 0 0 0 0 0 1 0 0 1 1 0 1 0 0 1 0 0 1 1 0 1 1 1 0 0 1 1 0 0 1 1 0 0 0 1 1 1 0 0 0 0 1 0 0 1 1 0 0 0 0 0 1 0 0 1 1) 12.716986 #r(0.000000 1.614268 0.794652 0.719356 1.522693 1.839206 0.053187 -0.216045 1.077547 0.626072 0.992447 0.258424 0.613665 0.666154 0.797791 1.297151 0.666442 1.138663 1.568655 1.598721 1.081507 0.701607 1.189990 0.875992 0.670799 0.120588 0.002798 1.147193 1.214233 0.961367 1.487074 1.498267 0.315736 -0.163747 0.892348 0.853335 0.781180 0.904959 0.815695 1.365580 -0.161311 1.770543 0.467808 0.858870 1.202500 1.263259 1.179260 0.605694 0.567979 0.170780 1.783259 0.557899 0.419137 1.246376 1.015382 0.060732 1.143789 0.421313 0.784488 -0.191174 0.582308 0.326318 0.868037 0.700245 1.775099 0.084259 0.487674 0.052341 -0.505041 0.601192 1.234546 0.060079 0.970347 0.831571 1.221404 0.028687 1.689191 1.030841 1.384017 0.852184 0.054733 0.492124 1.493372 0.743678 0.351949 0.983070 -0.060785 0.924421 0.622513 0.041911 1.106639 1.715696 0.158455 1.595681 0.922989 1.564481 1.036395 0.544443 1.152503 -0.027178) - 12.508295 #r(0.000000 1.571547 0.836020 0.778381 1.522830 -0.009437 -0.186704 -0.240415 1.153569 0.705593 0.844832 0.417085 0.595075 0.674560 0.777890 1.226758 0.737958 1.171819 1.521069 1.555546 1.027266 0.711975 1.273449 0.833807 0.701226 0.197554 -0.004653 1.149130 1.223877 0.823248 1.464452 1.373568 0.457287 -0.184249 0.770782 0.817218 0.744302 0.813250 0.671561 1.424574 -0.273880 1.806969 0.402858 0.840834 1.375205 1.221656 1.349704 0.441774 0.539676 0.188791 1.872676 0.544577 0.571590 1.450687 0.983073 0.031950 1.098169 0.489681 0.699271 -0.244018 0.708406 0.261430 0.888818 0.677915 1.750657 0.009610 0.340035 -0.188491 -0.409425 0.646348 1.418976 0.009312 1.062579 0.838958 1.321599 0.106000 1.896353 1.052055 1.340838 0.703680 0.165267 0.510131 1.428207 0.758356 0.222371 0.955460 -0.035678 0.733303 0.711783 0.091905 1.152199 1.539467 0.293672 1.651246 0.907914 1.585284 0.993898 0.453806 1.060558 -0.204617) + 12.507978 #r(0.000000 1.571576 0.836029 0.778379 1.522867 -0.009457 -0.186743 -0.240409 1.153585 0.705604 0.844838 0.417111 0.595063 0.674590 0.777944 1.226782 0.737916 1.171820 1.521080 1.555596 1.027275 0.711946 1.273408 0.833842 0.701230 0.197570 -0.004654 1.149172 1.223850 0.823264 1.464494 1.373573 0.457295 -0.184253 0.770780 0.817244 0.744306 0.813258 0.671616 1.424600 -0.273788 1.806947 0.402828 0.840824 1.375247 1.221599 1.349820 0.441761 0.539666 0.188775 1.872675 0.544579 0.571568 1.450748 0.983064 0.031927 1.098148 0.489679 0.699292 -0.244049 0.708419 0.261456 0.888868 0.677900 1.750620 0.009589 0.340081 -0.188490 -0.409400 0.646315 1.418970 0.009387 1.062568 0.838909 1.321634 0.105958 1.896395 1.052036 1.340801 0.703670 0.165320 0.510189 1.428199 0.758366 0.222380 0.955472 -0.035660 0.733303 0.711793 0.091925 1.152184 1.539471 0.293711 1.651264 0.907951 1.585266 0.993938 0.453757 1.060509 -0.204542) ) ;;; 101 prime -------------------------------------------------------------------------------- (vector 101 15.735968313601 #r(0 1 1 0 1 0 0 0 1 0 0 0 1 0 1 0 0 0 0 0 0 0 1 0 1 0 1 1 1 0 1 1 0 0 0 0 1 1 0 1 0 0 0 0 1 1 1 0 0 1 1 1 1 0 0 1 0 0 0 1 0 1 1 0 1 0 0 0 1 0 1 0 1 0 1 1 0 1 1 0 0 1 1 0 1 1 0 1 0 1 1 0 1 0 0 0 0 0 0 0 1) 12.654378 #r(0.000000 0.039802 1.217841 -0.018794 -0.264350 1.648606 -0.106572 1.436093 1.744759 1.197340 1.116039 0.322269 -0.319802 1.429760 1.337731 1.367755 1.294986 0.934427 1.178285 0.242928 0.397639 0.030160 0.470705 0.489509 0.721431 0.877160 0.586365 1.300090 0.056753 0.396042 0.694396 -0.123538 0.601882 1.828235 1.061453 1.208202 1.515734 1.300848 0.385739 1.295236 0.466727 1.125610 1.584167 0.360500 0.430768 1.515128 1.002486 1.429469 1.701067 0.146032 1.922601 1.668726 1.734188 0.898236 1.467655 0.751985 1.587598 0.572766 0.063367 1.242347 -0.141898 0.518327 1.188113 1.385035 1.498198 -0.400261 -0.058961 1.288706 1.366806 0.035365 1.606021 -0.052356 0.617357 0.512726 0.520602 1.405519 1.969640 -0.459289 0.438819 1.509996 1.047832 0.536024 0.230428 0.540739 1.290987 1.664498 0.615778 1.436029 1.298481 1.467348 0.158627 0.119363 1.098827 0.065055 0.380410 0.835569 0.455358 0.512707 1.391092 0.922515 1.335905) - 12.409876 #r(0.000000 0.033400 1.244885 -0.037706 -0.215881 1.593609 -0.079741 1.368786 1.677582 1.156309 1.096817 0.330977 -0.505630 1.383113 1.226857 1.487914 1.213218 0.940645 1.300536 0.251878 0.288816 0.071356 0.342605 0.588077 0.651173 0.942117 0.513960 1.311023 -0.028614 0.556985 0.621720 -0.133122 0.592862 1.773801 1.059320 1.258273 1.517853 1.427336 0.433234 1.258674 0.416518 1.223733 1.583094 0.384641 0.460767 1.555884 1.111326 1.409562 1.749454 -0.075183 1.898387 1.590110 1.758625 1.020050 1.411339 0.680472 1.646981 0.427174 0.140766 1.261472 -0.128800 0.582130 1.132136 1.490992 1.386002 -0.426241 -0.106757 1.357391 1.343122 -0.000838 1.632269 -0.082103 0.530096 0.509039 0.488114 1.286432 0.101139 -0.553814 0.370839 1.457015 1.060610 0.479657 0.265825 0.432785 1.299109 1.729999 0.651827 1.353393 1.367857 1.374440 0.319494 0.193070 1.146014 0.029020 0.471092 0.775778 0.313944 0.491354 1.297792 1.042352 1.270050) + 12.407239 #r(0.000000 -0.012226 1.218520 -0.050030 -0.197707 1.563774 -0.135704 1.352419 1.662529 1.161726 1.088916 0.340074 -0.506907 1.356173 1.212408 1.528607 1.215923 0.917747 1.314969 0.254710 0.298139 0.093591 0.334651 0.604247 0.644003 0.946110 0.517937 1.275957 -0.033696 0.564591 0.602618 -0.137149 0.595693 1.786308 1.099061 1.230973 1.483055 1.387352 0.442573 1.298187 0.406529 1.207437 1.581567 0.397964 0.428748 1.534150 1.139582 1.371977 1.757460 -0.085595 1.890268 1.568923 1.743920 1.019111 1.374409 0.696222 1.644741 0.418644 0.133023 1.262216 -0.142142 0.598461 1.156170 1.496918 1.399929 -0.379494 -0.164429 1.333168 1.357786 0.004577 1.616232 -0.075408 0.510693 0.505727 0.505445 1.251323 0.071381 -0.609698 0.343911 1.448933 1.072347 0.419390 0.272665 0.377398 1.273468 1.712343 0.567140 1.338173 1.354146 1.357601 0.295415 0.163249 1.123920 -0.024266 0.441426 0.715228 0.277963 0.485335 1.272398 1.021234 1.201355) ) ;;; 102 prime -------------------------------------------------------------------------------- (vector 102 15.374809992584 #r(0 0 1 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 0 0 0 0 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 1 0 0 1 0 1 1 1 0 1 1 0 0 1 1 1 1 0 1 0 1 1 0 1 1 0 0 1 1 0 0 0 1 1 1 0 0 1 0 0 1 0 1 0 0 1 1 0 0 0 1 0 0 0 1) 12.631141 #r(0.000000 0.074843 1.219158 -0.027199 -0.254073 1.624605 -0.135701 1.453877 1.755897 1.198675 1.090421 0.272002 -0.249474 1.447439 1.360955 1.341148 1.290153 0.969167 1.135329 0.243792 0.418984 1.946250 0.601544 0.456951 0.765282 0.872982 0.576621 1.365615 0.094262 0.399525 0.677984 -0.086420 0.567433 1.780255 1.046981 1.205389 1.534885 1.234066 0.439028 1.336514 0.490354 1.104410 1.622676 0.382214 0.417306 1.496561 0.975909 1.398390 1.624475 0.141661 1.921427 1.688187 1.741843 0.901238 1.419496 0.813192 1.607447 0.585967 -0.020824 1.251511 -0.203691 0.513177 1.192285 1.326136 1.473869 -0.455142 -0.016589 1.259703 1.293519 0.048863 1.685391 -0.099881 0.662916 0.500247 0.557103 1.438861 1.941547 -0.474933 0.373608 1.542760 1.006189 0.593009 0.247793 0.539650 1.340923 1.675659 0.620550 1.469642 1.328665 1.442498 0.149610 0.049207 1.111223 0.085126 0.353623 0.826677 0.461777 0.518667 1.404379 0.899861 1.337308 0.525132) - 12.543898 #r(0.000000 0.127959 1.212930 -0.029725 -0.234552 1.659777 -0.147455 1.398027 1.810328 1.156688 1.086500 0.363432 -0.268429 1.377050 1.368369 1.408803 1.320497 0.884603 1.192614 0.182854 0.396896 0.000654 0.569548 0.548761 0.805319 0.818016 0.599581 1.275187 -0.016885 0.393460 0.580728 -0.103611 0.603240 1.756926 1.002417 1.222432 1.604122 1.277286 0.508570 1.322659 0.586336 1.108154 1.581504 0.345155 0.400682 1.420335 1.009037 1.380339 1.660980 0.048307 1.916381 1.658147 1.718623 0.955099 1.439508 0.807480 1.619362 0.588582 -0.011814 1.195189 -0.281902 0.580078 1.191325 1.392565 1.431747 -0.465599 -0.053131 1.177666 1.309874 0.045934 1.724686 -0.060995 0.702028 0.421658 0.532221 1.410367 1.831158 -0.524903 0.461606 1.505370 0.996098 0.532086 0.292600 0.542151 1.340101 1.668887 0.644756 1.399889 1.250587 1.437035 0.160641 0.037601 1.118630 0.048300 0.343292 0.775077 0.420364 0.527731 1.378017 0.895885 1.270893 0.526556) + 12.529139 #r(0.000000 0.125932 1.242670 -0.030144 -0.241390 1.665286 -0.132627 1.375379 1.802214 1.153440 1.075777 0.340611 -0.249872 1.361166 1.335164 1.437122 1.355594 0.871786 1.217009 0.157321 0.420330 0.030365 0.508854 0.538811 0.828948 0.832497 0.578969 1.226903 -0.037045 0.449716 0.529326 -0.124175 0.603561 1.779823 1.083674 1.188747 1.621891 1.256994 0.484791 1.323959 0.580625 1.083582 1.539533 0.362259 0.406320 1.481055 1.015066 1.420568 1.695721 0.035785 1.898765 1.649300 1.718022 0.975150 1.424492 0.797506 1.644660 0.572156 -0.025643 1.177401 -0.296697 0.600559 1.195878 1.401417 1.399596 -0.500267 -0.078318 1.181766 1.303354 -0.004816 1.742959 -0.038031 0.703890 0.445705 0.502835 1.403460 1.782541 -0.522008 0.432488 1.508020 0.972875 0.514419 0.328727 0.540559 1.348618 1.678534 0.610957 1.399999 1.271307 1.438088 0.123830 0.120340 1.099043 0.016254 0.349064 0.765984 0.356444 0.508708 1.399044 0.924900 1.296770 0.531765) ) ;;; 103 prime -------------------------------------------------------------------------------- @@ -3068,21 +3068,21 @@ (vector 104 15.919013023376 #r(0 1 0 1 1 0 0 1 0 1 0 1 0 0 1 1 0 0 1 1 0 1 0 0 0 0 1 0 0 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 0 1 0 1 1 0 0 0 0 1 0 0 0 1 1 1 0 1 1 0 0 0 0 1 0 1 1 1 1 0 0 1 1 0 1 1 0 1 0 1 0 1 1 1 0 1 0 0 1 1 1 0 0 1 1 0 1 0 0 1) 12.987392 #r(0.000000 0.019656 1.020820 -0.122857 -0.383416 1.743762 -0.077551 1.285344 1.556500 1.347778 1.007108 0.271391 -0.017599 1.323289 1.224441 1.254961 1.192419 0.950226 1.083964 0.356128 0.296702 1.898956 0.423819 0.431784 0.740632 0.838009 0.555934 1.287966 0.437690 0.641910 0.602950 -0.082685 0.609730 1.650999 1.107220 1.287768 1.459073 1.340092 0.368618 1.276887 0.523746 1.035407 1.951274 0.598910 0.440828 1.523180 1.064599 1.442876 1.610632 0.084831 1.933213 1.678415 1.492367 0.869607 1.168981 0.759731 1.683066 0.461763 1.964877 1.344876 -0.085783 0.568560 1.208659 1.424190 1.445388 -0.303350 1.915514 1.421848 1.165687 -0.066096 1.641117 0.068094 0.584541 0.457188 0.559162 1.501643 1.956646 -0.560037 0.043217 1.538096 1.142301 0.678432 0.239030 0.380298 1.373491 1.617773 0.449327 1.348144 1.243227 1.328890 0.139617 0.253213 1.094223 0.214901 0.235818 0.939054 0.321415 0.563100 1.348449 0.703267 1.435425 0.687968 1.242454 -0.344280) - 12.874708 #r(0.000000 -0.008997 0.978092 -0.168546 -0.309009 1.908331 -0.114619 1.322551 1.512791 1.442416 1.033381 0.266375 -0.025841 1.267085 1.224220 1.250721 1.190175 0.983594 1.076635 0.394355 0.380032 1.897998 0.487051 0.368548 0.730283 0.826960 0.566878 1.226068 0.454110 0.641009 0.598834 -0.069247 0.657042 1.715983 1.063666 1.274882 1.467870 1.324297 0.445538 1.348143 0.593986 0.995632 0.026520 0.576694 0.477534 1.470910 1.105536 1.471287 1.571047 0.123951 1.983517 1.628463 1.486494 0.890955 1.273738 0.780422 1.697870 0.512118 -0.024532 1.300154 -0.030174 0.625994 1.258423 1.397245 1.439062 -0.366052 1.905508 1.379600 1.224750 -0.071003 1.661228 0.030908 0.620528 0.531914 0.549648 1.517197 0.040267 -0.577400 0.064950 1.583375 1.152305 0.618185 0.333958 0.344024 1.385369 1.608363 0.501460 1.380766 1.272245 1.366036 0.092741 0.247193 1.137537 0.282664 0.206799 0.992372 0.355211 0.558113 1.520174 0.582100 1.425796 0.762295 1.272984 -0.389916) + 12.846452 #r(0.000000 0.013672 1.001616 -0.153678 -0.287547 1.879358 -0.089375 1.368893 1.496968 1.425029 1.080288 0.310442 -0.049861 1.227294 1.228494 1.227436 1.141060 1.024081 1.191994 0.369450 0.391906 1.945630 0.502782 0.375353 0.763841 0.841482 0.562358 1.202206 0.381838 0.629706 0.597268 -0.094328 0.748715 1.818315 1.064236 1.308585 1.455707 1.344922 0.522360 1.359630 0.537609 0.976374 -0.028358 0.537761 0.467549 1.466311 1.155176 1.502283 1.584519 0.089897 -0.007717 1.555824 1.471306 0.855248 1.242092 0.786653 1.706579 0.456771 0.022396 1.324598 -0.037021 0.674537 1.254774 1.336032 1.420502 -0.351871 1.945955 1.420613 1.238958 -0.045996 1.688537 0.010813 0.591535 0.540138 0.534883 1.545763 0.037757 -0.548107 0.113742 1.646650 1.194736 0.579989 0.328681 0.290629 1.400610 1.652726 0.492393 1.317900 1.234915 1.354324 0.091506 0.243551 1.195232 0.277537 0.217549 1.033457 0.340594 0.526430 1.489025 0.523613 1.442688 0.809706 1.280994 -0.388495) ) ;;; 105 prime -------------------------------------------------------------------------------- (vector 105 16.038356734428 #r(0 0 0 1 0 1 1 0 0 0 0 1 0 0 0 0 0 0 1 1 0 1 0 0 0 1 0 1 1 1 1 1 0 0 0 1 0 1 0 0 0 0 1 1 1 0 0 0 0 0 0 0 1 1 0 1 0 1 1 0 1 1 1 1 1 1 0 0 0 0 1 1 0 0 1 1 1 0 0 1 1 1 0 0 0 1 1 0 1 1 1 0 1 0 0 0 1 1 1 1 1 1 0 1 0) 13.058436 #r(0.000000 0.018841 0.195855 0.206420 0.065633 1.458550 0.564954 0.584050 0.255393 0.821477 0.473289 1.497087 0.488701 0.595510 1.763919 1.795152 1.020709 0.148507 1.419452 -0.190874 1.252819 -0.115417 1.572364 1.086172 1.203320 0.123978 1.519196 1.337538 1.222474 1.661628 1.792441 1.530814 0.073522 0.146382 0.880812 1.383907 1.455106 1.313842 0.612949 1.097744 0.661951 0.056058 0.292577 0.309700 1.553938 1.839317 1.798626 0.412574 -0.220475 0.391331 1.230536 1.329793 -0.061036 0.863566 1.369439 -0.108592 1.446517 1.870258 0.562986 0.909666 0.015512 0.313473 0.325423 1.421234 1.107012 0.906081 -0.185513 0.052032 0.945263 0.140137 1.151954 1.558716 1.433167 -0.154754 1.358982 -0.108152 1.794830 0.776903 1.411273 0.506284 0.746113 0.870064 0.655404 0.430773 1.492137 1.947814 1.106281 1.476409 1.624757 1.670125 1.262143 0.090556 0.017948 1.208649 1.518613 0.097884 0.893396 1.883764 0.459504 1.072858 0.258050 0.025247 0.792929 1.431035 1.911968) - 12.986563 #r(0.000000 0.006266 0.189761 0.226163 0.035073 1.482473 0.582452 0.580471 0.375208 0.808410 0.448268 1.607959 0.443683 0.600122 1.728590 1.860545 1.034082 0.144167 1.442257 -0.237103 1.353135 -0.110449 1.591836 1.020495 1.227418 0.103557 1.527501 1.368454 1.214370 1.695531 1.850634 1.548630 0.041905 0.125446 0.834497 1.373689 1.438164 1.310689 0.555442 1.107009 0.714765 0.084864 0.316134 0.303268 1.603017 1.844289 1.847319 0.438903 -0.188785 0.336094 1.244115 1.316966 -0.044763 0.820957 1.312479 -0.135652 1.414799 1.828682 0.524963 0.859675 0.020469 0.230639 0.322576 1.379138 1.134476 0.882562 -0.133839 0.060259 0.860608 0.144194 1.123975 1.594786 1.469097 -0.174625 1.290362 -0.124539 1.748997 0.803737 1.389030 0.412247 0.715750 0.909876 0.602478 0.383451 1.409527 1.886854 1.054427 1.440975 1.628650 1.685191 1.211705 0.068453 -0.001147 1.250630 1.576255 0.087127 0.826231 1.822442 0.369254 1.056811 0.211209 0.048102 0.774578 1.427105 1.813672) + 12.954192 #r(0.000000 0.043686 0.153231 0.193870 0.025540 1.567686 0.547883 0.653768 0.427650 0.778347 0.361824 1.606549 0.435259 0.624940 1.781116 1.845158 1.031369 0.134195 1.450787 -0.162712 1.384114 -0.148138 1.664036 1.003695 1.254150 0.069341 1.529890 1.355298 1.254762 1.723544 1.852343 1.551784 0.108040 0.063524 0.809307 1.403514 1.548445 1.326002 0.579944 1.116646 0.675955 0.106306 0.328224 0.302855 1.582359 1.852184 1.853476 0.524742 -0.148884 0.384243 1.266488 1.306701 -0.014733 0.843884 1.259426 -0.126259 1.447530 1.816898 0.523888 0.828999 0.042931 0.299928 0.265950 1.382099 1.155464 0.868911 -0.110351 0.050257 0.863194 0.142777 1.075011 1.583531 1.516046 -0.175825 1.329908 -0.123517 1.769079 0.843586 1.423245 0.432582 0.773709 0.905875 0.603999 0.394709 1.432183 1.810503 1.103910 1.448740 1.744442 1.722100 1.322899 0.072711 -0.003589 1.216860 1.629730 0.108998 0.837783 1.899559 0.384437 0.984192 0.265128 0.119666 0.698442 1.349422 1.843200) ) ;;; 106 prime -------------------------------------------------------------------------------- (vector 106 15.730461834714 #r(0 1 0 1 1 1 1 0 0 0 1 0 1 0 1 1 1 0 0 0 1 1 0 1 0 1 1 0 0 0 1 1 1 1 1 0 0 0 1 1 1 1 0 0 0 1 1 0 0 1 1 1 1 0 1 0 0 1 0 1 1 1 1 1 1 1 0 0 1 1 1 1 0 0 1 1 0 0 1 0 0 1 0 1 1 0 1 1 0 1 0 0 0 0 0 0 0 1 1 1 1 0 1 1 0 1) 13.079950 #r(0.000000 0.991683 1.667079 0.952198 -0.158134 0.908256 -0.128985 1.883696 0.540349 0.614398 0.596989 0.783975 1.428368 1.597136 0.736884 1.252068 1.305873 0.231319 1.020117 1.388373 0.377031 1.796792 1.091025 -0.916486 1.247592 1.449627 1.096507 0.594132 -0.088485 1.169711 1.329459 0.003695 0.368539 -0.180221 0.842521 1.314435 1.291992 1.272149 0.292625 1.025337 1.197144 0.687141 1.597409 1.201509 1.264866 0.210655 0.462014 0.072105 1.054043 0.490923 0.945944 1.071461 0.064888 0.965001 1.073253 1.205548 1.546442 0.256599 0.512902 -0.205146 0.188856 1.063444 0.616804 1.743279 0.914154 0.807038 1.016753 1.132350 0.990751 0.400337 1.345943 0.880688 0.534474 0.323663 1.462334 0.913980 0.240611 1.904272 0.651788 0.182999 -0.180558 -0.266742 1.405697 0.476547 1.309300 1.415664 1.075072 1.577006 1.108476 0.911007 -0.337178 0.168855 1.245061 1.768086 1.542431 1.828360 0.829179 1.275739 -0.086776 0.463079 -0.336090 0.362914 1.505253 0.753982 0.654367 1.043320) - 12.986543 #r(0.000000 0.933620 1.724884 0.902260 -0.094392 0.782784 -0.037895 1.912164 0.511402 0.640168 0.544551 0.871173 1.424201 1.601706 0.798152 1.151787 1.402478 0.211133 1.056113 1.560008 0.335621 1.806920 1.077243 -0.902944 1.301087 1.457429 1.121041 0.554298 -0.152025 1.100479 1.343214 0.063366 0.339446 -0.173294 0.839497 1.203727 1.284703 1.201430 0.407549 1.113486 1.229675 0.761044 1.648568 1.187662 1.217080 0.212384 0.467162 0.073026 1.000212 0.593772 1.156632 1.079288 -0.004771 0.887212 1.005167 1.174560 1.532708 0.343465 0.447854 -0.297484 0.240407 1.084203 0.626378 1.729391 0.878367 0.728355 0.962031 1.109962 0.972337 0.387710 1.201739 0.859169 0.430511 0.466184 1.417022 0.869075 0.156903 1.788940 0.673116 0.219782 -0.076890 -0.292370 1.425467 0.488360 1.402490 1.391936 0.948763 1.541288 1.145000 1.015690 -0.387172 0.121984 1.220169 1.790056 1.536604 1.829363 0.830122 1.267235 -0.023614 0.485110 -0.445672 0.254776 1.570641 0.813184 0.587583 1.024248) + 12.826410 #r(0.000000 0.861134 1.794032 0.909813 -0.072287 0.805279 -0.022613 1.915116 0.487371 0.644186 0.482110 0.882374 1.425329 1.766153 0.856644 1.141008 1.402548 0.168833 1.086665 1.632409 0.264007 1.761124 1.065381 -0.884236 1.350680 1.453813 1.162526 0.515405 -0.202305 1.099642 1.364100 0.132974 0.270947 -0.138339 0.758489 1.145831 1.277779 1.095710 0.405094 1.097750 1.338557 0.833113 1.752830 1.173243 1.150252 0.227574 0.486801 -0.031517 1.062108 0.616354 1.251519 1.168405 0.053198 0.848516 1.036647 1.199261 1.552163 0.435508 0.431810 -0.361266 0.335116 1.107204 0.641276 1.785433 0.862362 0.677486 0.900897 1.116376 0.973852 0.363680 1.253770 0.865659 0.378530 0.565956 1.306417 0.840981 0.126485 1.768454 0.735016 0.332441 -0.086946 -0.177580 1.538375 0.517132 1.409449 1.358953 0.910398 1.554219 1.242523 1.042828 -0.465756 0.125758 1.215807 1.784823 1.617425 1.815860 0.875139 1.373628 0.032504 0.462510 -0.488896 0.192285 1.638314 0.849725 0.578371 1.055405) ) ;;; 107 prime -------------------------------------------------------------------------------- @@ -3090,112 +3090,105 @@ ;; 106+1 13.202367 #r(0.000000 1.000613 1.684756 1.030591 -0.144674 0.930087 -0.073206 1.869216 0.492462 0.667691 0.532693 0.721976 1.419258 1.577138 0.740297 1.322068 1.346534 0.154223 1.065715 1.368889 0.410182 1.822841 1.125450 -0.885511 1.290555 1.433074 1.046721 0.707499 -0.124656 1.201693 1.347393 0.018662 0.502177 -0.078873 0.756433 1.230311 1.259142 1.367069 0.315216 1.023759 1.259356 0.661168 1.411343 1.215010 1.266771 0.189892 0.505302 -0.011494 1.187732 0.519532 0.949942 1.050962 -0.019894 1.078182 0.992807 1.143414 1.633065 0.324324 0.492441 -0.218768 0.188780 0.963413 0.578702 1.692089 1.002935 0.841457 1.096611 1.231089 0.982778 0.479408 1.297577 0.816566 0.491832 0.381540 1.447787 0.924630 0.221301 1.796849 0.662118 0.111778 -0.098285 -0.205921 1.443651 0.375879 1.302820 1.419045 1.157539 1.514324 1.141534 0.934891 -0.258550 0.136149 1.293417 1.740995 1.504775 1.852338 0.849037 1.301984 -0.143638 0.497510 -0.382560 0.320355 1.490322 0.666001 0.663075 0.925267 0.075096) - 13.095114 #r(0.000000 0.996434 1.734989 1.092173 -0.128502 0.853273 -0.041347 1.871857 0.532523 0.669003 0.502015 0.663125 1.400325 1.639317 0.743495 1.331403 1.329285 0.149900 1.126476 1.382101 0.354082 1.774680 1.170520 -0.862068 1.356548 1.356343 1.068955 0.693315 -0.141822 1.144942 1.383925 0.113097 0.508921 -0.037371 0.725437 1.194595 1.314265 1.361827 0.291107 1.034468 1.249057 0.684793 1.380179 1.228520 1.236519 0.158384 0.497493 -0.097654 1.226129 0.509048 0.976820 1.133817 -0.079193 1.185108 1.032658 1.061951 1.590137 0.384766 0.465554 -0.225166 0.268235 0.910143 0.554811 1.618390 0.995099 0.921045 1.080506 1.228669 0.904090 0.425707 1.261194 0.815316 0.425529 0.311707 1.375396 0.911662 0.195586 1.850778 0.663549 0.070061 -0.059047 -0.186662 1.507499 0.327458 1.280029 1.460397 1.123605 1.461883 1.167550 0.878767 -0.229742 0.065381 1.319656 1.759005 1.522649 1.834226 0.892467 1.310985 -0.168347 0.535150 -0.507951 0.268438 1.469959 0.601336 0.685214 0.879939 0.085500) + 13.062223 #r(0.000000 1.008494 1.750386 1.080409 -0.102519 0.841503 -0.078147 1.839372 0.590367 0.647302 0.515515 0.585593 1.451878 1.578929 0.691405 1.479294 1.354366 0.141018 1.121698 1.359987 0.311100 1.711401 1.196632 -0.969935 1.362027 1.193701 1.036461 0.683269 -0.131378 1.118863 1.329852 0.159634 0.543440 -0.039983 0.674789 1.151842 1.300955 1.273048 0.324172 1.053223 1.203027 0.752949 1.396744 1.309335 1.278774 0.163684 0.402680 -0.224198 1.237657 0.561058 1.054124 1.202459 -0.188602 1.161316 1.037224 1.021667 1.632229 0.310741 0.429028 -0.285441 0.340050 0.930769 0.480213 1.698338 0.906318 0.933109 0.999192 1.310273 0.820881 0.426129 1.299372 0.819333 0.360826 0.265108 1.326431 0.849585 0.176282 1.806362 0.695144 0.074256 0.050240 -0.335778 1.497113 0.227021 1.205299 1.405977 1.151057 1.530339 1.238604 0.835874 -0.279741 0.083586 1.356663 1.693560 1.460800 1.733249 0.838478 1.292550 -0.153859 0.404684 -0.479289 0.288988 1.424976 0.644215 0.702026 0.789763 0.211555) ) ;;; 108 prime -------------------------------------------------------------------------------- (vector 108 16.517358779907 #r(0 1 0 0 0 0 0 1 0 1 1 1 1 1 0 1 1 1 1 0 1 0 0 1 0 0 1 0 0 1 0 0 0 0 1 0 1 1 0 0 0 1 0 0 0 0 1 1 0 1 1 1 1 0 0 0 1 0 1 0 0 1 1 0 1 1 0 0 0 0 0 0 0 1 0 0 0 0 0 1 1 1 0 1 0 1 1 0 1 0 1 1 0 0 0 1 0 1 1 0 1 1 0 1 0 1 0 1) 13.161718 #r(0.000000 0.987739 1.733133 1.054188 -0.119939 0.910849 0.010896 1.915591 0.510331 0.662472 0.507733 0.711187 1.421434 1.531951 0.698359 1.366502 1.433114 0.162830 1.031829 1.385260 0.380744 1.872146 1.120453 -0.900242 1.311562 1.361998 1.093182 0.717990 -0.097277 1.161510 1.367817 0.082904 0.485601 -0.064734 0.731587 1.181418 1.308157 1.250173 0.316423 1.011227 1.301355 0.644463 1.445963 1.205118 1.208647 0.244654 0.589262 -0.059634 1.176596 0.571146 1.043371 1.083159 0.006076 1.077933 0.991663 1.165270 1.605164 0.390047 0.441435 -0.106544 0.175661 1.010931 0.543321 1.751721 0.965777 0.870079 1.024670 1.181296 0.990067 0.440808 1.351390 0.806214 0.421993 0.407648 1.468845 0.828507 0.187943 1.771172 0.634836 0.107090 -0.067569 -0.177001 1.469562 0.463678 1.334677 1.387523 1.126011 1.572881 1.170585 1.010919 -0.335535 0.129689 1.331430 1.676924 1.536965 1.783188 0.838550 1.260495 -0.084649 0.463288 -0.384118 0.341860 1.494266 0.699617 0.647486 0.913118 0.121686 0.025406) - 12.997814 #r(0.000000 1.038069 1.815004 1.105315 -0.152944 0.903342 0.041318 1.946065 0.533324 0.681461 0.484914 0.713847 1.329210 1.555048 0.697490 1.423233 1.439993 0.099067 1.067559 1.360725 0.377870 1.796041 1.079058 -0.905060 1.348426 1.324447 1.149285 0.708246 -0.101899 1.094031 1.339710 0.084434 0.513213 -0.061281 0.664717 1.081489 1.343798 1.114389 0.307875 1.003119 1.343770 0.604620 1.515859 1.157242 1.107552 0.261835 0.617336 -0.185614 1.161702 0.542420 1.046857 1.189816 -0.102350 1.088713 1.064498 1.161851 1.631452 0.444955 0.425235 -0.123029 0.263825 0.965486 0.529748 1.774848 0.948177 0.850343 1.012523 1.208181 0.955762 0.329772 1.269309 0.792343 0.430013 0.429785 1.343489 0.811036 0.212224 1.709060 0.618066 0.210462 -0.072764 -0.145370 1.425653 0.469586 1.313806 1.347333 1.117523 1.523571 1.154056 0.955439 -0.336936 0.076113 1.318038 1.710311 1.618826 1.742929 0.890128 1.296362 -0.113420 0.430625 -0.458621 0.321520 1.438911 0.727451 0.695601 0.858975 0.222901 -0.002884) + 12.974379 #r(0.000000 1.121892 1.855902 1.022039 -0.184631 0.890520 0.036343 1.918697 0.493687 0.672445 0.438537 0.734809 1.393522 1.563450 0.645281 1.430906 1.400127 0.110141 1.063949 1.375307 0.351138 1.873689 1.001652 -0.879668 1.395671 1.277337 1.143531 0.760690 -0.110194 1.106085 1.332925 0.072852 0.521913 -0.018497 0.688860 1.086481 1.339351 1.062679 0.282380 1.023534 1.378405 0.577159 1.583596 1.166220 1.015256 0.222404 0.650910 -0.234724 1.124867 0.548765 1.026033 1.284292 -0.067024 1.016411 1.109637 1.149435 1.568553 0.495401 0.420927 -0.132895 0.288373 0.934502 0.581592 1.820816 0.917919 0.813859 0.999058 1.260672 0.954539 0.372858 1.278623 0.759530 0.433847 0.392803 1.364693 0.708043 0.210863 1.741035 0.629507 0.189017 -0.072870 -0.171414 1.372917 0.514343 1.238624 1.286696 1.104651 1.536594 1.163779 1.038516 -0.327687 0.085920 1.268960 1.729857 1.631146 1.754137 0.880211 1.299069 -0.084945 0.380146 -0.451097 0.328738 1.400385 0.741325 0.728354 0.859541 0.237138 -0.026769) ) ;;; 109 prime -------------------------------------------------------------------------------- (vector 109 16.726722717285 #r(0 0 1 0 0 0 1 0 0 0 0 1 0 1 0 1 0 0 0 1 0 0 1 1 1 1 0 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 1 0 0 1 0 1 0 1 1 0 0 1 1 0 1 1 0 0 0 0 1 0 0 1 0 0 0 0 1 0 0 0 0 0 0 1 0 0 1 1 1 1 0 1 1 0 0 0 1 1 0 1 0 1 1 0 1 1 1 1 0 1 1 0 1 1 1) 13.143741 #r(0.000000 0.981295 1.812666 1.117956 -0.185500 0.887133 -0.042123 1.869958 0.605292 0.660698 0.487240 0.624166 1.449694 1.534689 0.782613 1.451064 1.414295 0.227989 1.073340 1.379009 0.377980 1.849622 1.090582 -0.935851 1.300468 1.325519 1.018826 0.640677 -0.151618 1.157148 1.372788 0.030561 0.535214 0.003928 0.716545 1.230702 1.288510 1.214069 0.401399 1.044897 1.420969 0.699802 1.461844 1.182797 1.140031 0.222134 0.599399 -0.075721 1.205878 0.475321 1.079680 1.212881 -0.096955 1.107746 1.109769 1.169670 1.644352 0.462528 0.400247 -0.075889 0.244499 0.883273 0.555132 1.799341 1.047944 0.815280 0.989170 1.236643 1.002684 0.340197 1.339964 0.830022 0.342213 0.420385 1.313509 0.797027 0.138670 1.741420 0.612419 0.142853 -0.104009 -0.165428 1.519255 0.376528 1.265335 1.374075 1.080427 1.589793 1.292179 1.057071 -0.356737 0.109826 1.273643 1.715122 1.539078 1.804591 0.847821 1.225593 -0.104087 0.410682 -0.411370 0.366927 1.453570 0.665830 0.721383 0.960549 0.197868 0.027654 -0.001988) - 13.103620 #r(0.000000 1.045157 1.773535 1.109310 -0.139393 0.854280 0.006352 1.935283 0.608220 0.674388 0.495583 0.611489 1.415568 1.532272 0.809022 1.491106 1.459906 0.212958 1.119755 1.338085 0.400434 1.907422 1.144038 -0.907473 1.322595 1.315701 1.002153 0.653722 -0.126986 1.160240 1.378626 0.048878 0.589993 0.084708 0.666985 1.120287 1.300680 1.237668 0.395499 1.062130 1.470169 0.700432 1.424377 1.240137 1.169195 0.189428 0.684423 -0.103304 1.242157 0.471892 1.102965 1.196134 -0.070399 1.176909 1.133988 1.102438 1.673391 0.480971 0.394639 -0.085169 0.291080 0.898222 0.519168 1.782066 1.090589 0.795462 0.996212 1.279079 0.992714 0.358738 1.360074 0.806787 0.261449 0.420293 1.283594 0.756286 0.127633 1.742384 0.618976 0.149222 0.017273 -0.148366 1.528126 0.390130 1.273225 1.406180 1.104770 1.559750 1.272473 1.051311 -0.355654 0.108302 1.265415 1.761107 1.576328 1.830750 0.901505 1.221586 -0.069795 0.350185 -0.434231 0.346083 1.429956 0.715618 0.748505 0.928890 0.194401 0.031031 -0.029425) + 13.070926 #r(0.000000 1.033364 1.861039 1.139727 -0.090729 0.833301 -0.041177 1.925387 0.654603 0.667088 0.428440 0.648091 1.491857 1.553765 0.941855 1.543839 1.497137 0.223607 1.112083 1.348434 0.448017 1.866993 1.112909 -0.904181 1.327404 1.261341 0.951686 0.726834 -0.122200 1.310607 1.451477 0.068519 0.545688 0.025827 0.719293 1.113856 1.278266 1.182049 0.418533 1.122433 1.444302 0.687741 1.474052 1.250452 1.179458 0.102857 0.717413 -0.200719 1.298588 0.414015 1.130052 1.198233 -0.070847 1.075804 1.076842 1.032713 1.645303 0.401984 0.473026 -0.109303 0.265609 0.943707 0.554144 1.758062 1.104979 0.815340 0.973133 1.292760 0.953733 0.373336 1.384489 0.841636 0.279624 0.503491 1.290936 0.742848 0.156986 1.727598 0.736026 0.175209 -0.078655 -0.036207 1.567100 0.399602 1.261996 1.413564 1.111969 1.624456 1.361303 1.025147 -0.386997 0.180034 1.328570 1.712065 1.527540 1.843669 0.923368 1.299425 -0.002010 0.372244 -0.402417 0.340626 1.392549 0.779611 0.758572 0.892133 0.200700 0.038712 0.006858) ) ;;; 110 prime -------------------------------------------------------------------------------- (vector 110 16.455888332339 #r(0 1 1 0 1 1 1 1 1 0 0 1 0 0 0 0 0 1 0 0 0 1 1 1 0 0 1 1 1 0 0 0 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 0 1 0 1 0 1 0 1 1 0 1 1 0 1 1 0 1 1 0 1 0 0 0 0 0 1 0 0 1 0 0 0 1 0 1 0 1 0 0 1 1 0 1 0 1 0 1 1 0 1 0 1 1 0 0 1 0 0 1 1 1 1) 13.385857 #r(0.000000 1.005423 1.782283 1.037310 -0.213053 0.879928 -0.046517 1.873303 0.602952 0.747924 0.548631 0.551919 1.533520 1.564233 0.767686 1.439845 1.429058 0.210745 1.048360 1.272572 0.420497 1.907528 1.007798 -0.875985 1.280681 1.283565 1.002224 0.663448 -0.175829 1.191021 1.396519 0.008645 0.463633 -0.035145 0.773513 1.183723 1.280027 1.209216 0.370736 1.024088 1.346178 0.572424 1.493165 1.210957 1.190749 0.243885 0.627363 -0.093472 1.163170 0.538660 1.062757 1.203025 -0.076830 1.020755 1.065456 1.180141 1.616909 0.426164 0.442881 -0.033300 0.224949 0.880028 0.544694 1.835856 0.965989 0.842443 0.993190 1.292542 0.995849 0.354562 1.374934 0.864622 0.357717 0.414238 1.429257 0.844435 0.199497 1.704803 0.599091 0.164856 -0.041591 -0.188982 1.576927 0.379552 1.197978 1.412448 1.100509 1.573418 1.244031 1.006949 -0.394739 0.102675 1.270463 1.672535 1.525836 1.772058 0.832852 1.187053 -0.004100 0.474378 -0.431920 0.321063 1.410302 0.680526 0.673358 0.951529 0.162772 0.079611 0.022569 0.116743) - 13.243809 #r(0.000000 0.994303 1.889182 1.027773 -0.161700 0.853878 -0.081551 1.769259 0.679450 0.825564 0.490811 0.540338 1.456764 1.486485 0.696583 1.407882 1.421772 0.173661 1.136337 1.232897 0.473000 1.945747 0.987770 -0.833664 1.288425 1.264713 1.008796 0.661828 -0.191071 1.209994 1.350943 -0.010215 0.470430 0.019410 0.680691 1.139813 1.240304 1.197038 0.364114 1.013308 1.355238 0.539463 1.441836 1.166023 1.103232 0.230157 0.632365 -0.155451 1.189645 0.493037 1.056096 1.228615 0.022124 0.962656 1.167721 1.166310 1.649904 0.479164 0.389075 -0.036644 0.324515 0.867776 0.580523 1.766797 0.979468 0.838701 1.016642 1.277610 1.083891 0.369634 1.344723 0.834836 0.362309 0.382499 1.358654 0.819520 0.237680 1.671300 0.591062 0.122838 -0.005891 -0.131446 1.502857 0.390132 1.180764 1.422425 1.096192 1.569237 1.253669 1.074277 -0.365905 0.109421 1.246740 1.608761 1.499304 1.808293 0.849692 1.225635 0.008546 0.378667 -0.473657 0.362787 1.373362 0.754817 0.724014 1.014518 0.209760 0.038363 0.118639 0.355856) + 13.087910 #r(0.000000 1.014718 1.873932 1.009683 -0.106920 0.795991 -0.108205 1.772867 0.620459 0.888591 0.463892 0.559518 1.450610 1.494332 0.710469 1.396168 1.366144 0.035259 1.221652 1.322338 0.508476 1.846404 0.985884 -0.866229 1.267386 1.380915 0.991388 0.710982 -0.159034 1.195579 1.316755 0.042797 0.446024 0.082897 0.698103 1.212257 1.222100 1.294015 0.327434 1.000247 1.383287 0.510272 1.474014 1.176170 1.049972 0.238762 0.614272 -0.277465 1.158535 0.531202 1.069817 1.251646 0.041677 0.877183 1.296481 1.141492 1.594711 0.535947 0.373960 -0.059021 0.307884 0.876395 0.573933 1.601239 0.957638 0.800801 1.069428 1.337813 1.059588 0.312225 1.274733 0.895580 0.378242 0.289365 1.297252 0.793539 0.237243 1.575516 0.570774 0.087221 -0.081966 -0.083850 1.490500 0.387856 1.129970 1.372699 1.072440 1.582166 1.352116 1.051648 -0.261230 0.055628 1.260568 1.550284 1.442323 1.782502 0.908771 1.240504 0.007516 0.330353 -0.433273 0.316764 1.457844 0.654785 0.808654 0.864960 0.250140 -0.118733 0.153293 0.478629) ) ;;; 111 prime -------------------------------------------------------------------------------- (vector 111 16.6662 #r(0 1 0 1 0 0 0 1 1 0 0 1 0 0 1 1 0 1 0 1 1 0 0 0 1 1 1 1 1 0 1 1 1 0 0 0 1 1 0 1 0 0 0 0 1 1 0 0 1 0 1 1 0 1 0 0 1 1 0 1 0 1 1 1 1 1 1 0 1 1 0 1 0 0 0 0 1 1 1 1 1 0 0 1 0 1 0 1 1 1 0 1 0 1 1 0 1 1 0 0 1 1 0 0 0 1 1 0 1 0 0) - 13.722535 #r(0.000000 0.609754 0.477824 0.498205 -0.160828 1.311478 1.827872 1.163524 0.877088 0.528558 0.012460 0.425841 0.347225 1.111527 1.506620 1.410636 0.996952 -0.131493 1.544916 1.238729 0.920166 1.777555 1.246912 0.483008 1.025725 -0.124782 0.923160 0.448660 1.543112 1.342373 1.038202 0.935130 1.601650 0.963178 1.878258 0.588174 1.312098 0.758893 0.091784 1.903351 1.707234 0.845481 0.771218 1.534277 0.275800 0.904288 0.700394 1.584631 1.096911 0.048546 1.076681 -0.004790 1.712699 1.002701 0.028040 0.631055 0.000599 0.321247 1.728365 1.696152 0.050007 0.370978 0.617539 1.556864 1.281962 1.845086 1.923574 1.593500 1.577659 0.887043 0.956244 1.403764 1.038378 1.157002 1.529481 1.305687 0.017547 0.326930 0.654165 -0.007752 -0.267214 1.694215 0.852596 1.259529 0.832944 0.035647 0.361584 1.075053 1.075715 1.409307 1.062617 -0.201186 0.434486 -0.180399 1.188883 -0.221873 1.452975 -0.020938 0.072031 0.208492 1.474047 1.409906 0.615391 1.726165 0.685592 0.292682 1.428870 0.069915 -0.271563 0.353890 1.174756) - - ;; 110+1 13.484289 #r(0.000000 0.995043 1.654854 0.951488 -0.186960 0.850693 -0.104052 1.791806 0.632389 0.741244 0.372539 0.536429 1.585222 1.564873 0.754743 1.533715 1.436886 0.265913 1.082971 1.345237 0.422609 1.896766 1.047262 -0.941259 1.315104 1.247825 1.012008 0.626763 -0.163895 1.147771 1.361070 0.089508 0.489357 -0.001980 0.747126 1.129161 1.312043 1.244841 0.335129 1.099634 1.435470 0.558588 1.594865 1.187385 1.215330 0.231616 0.653215 -0.079848 1.147198 0.522561 1.074244 1.189158 0.024016 1.002127 1.145705 1.183921 1.636771 0.398476 0.358443 -0.058263 0.246181 0.942683 0.482681 1.823368 1.038771 0.798364 0.979012 1.260203 1.008839 0.331481 1.329527 0.889282 0.388705 0.378727 1.394091 0.860317 0.191774 1.792101 0.682065 0.246000 -0.121897 -0.155296 1.603714 0.392748 1.177859 1.362462 1.085317 1.557823 1.337471 1.045764 -0.299177 0.095852 1.207771 1.749557 1.574722 1.798042 0.795838 1.277804 -0.046897 0.399079 -0.477065 0.322241 1.436449 0.774690 0.635047 0.952898 0.197693 0.020089 0.072586 0.105711 -0.061722) + 13.370471 #r(0.000000 0.997472 1.677911 0.860184 -0.108780 0.795722 -0.055265 1.769371 0.727143 0.784882 0.378996 0.520646 1.537503 1.554312 0.796103 1.548854 1.483478 0.311113 1.081836 1.297847 0.434336 1.892891 1.198886 -0.985008 1.328755 1.295718 0.958900 0.614302 -0.153843 1.152546 1.306922 0.108800 0.541927 -0.036352 0.754261 1.023630 1.351273 1.237840 0.405135 1.088095 1.441102 0.527516 1.549382 1.180778 1.218853 0.263612 0.746948 -0.132225 1.158947 0.480891 1.061538 1.268277 0.064762 0.980342 1.142649 1.135050 1.623964 0.340391 0.318534 0.031789 0.232999 0.914060 0.466969 1.790698 1.032583 0.779716 1.062752 1.288313 0.966879 0.277772 1.296909 0.879838 0.399956 0.291078 1.360482 0.890804 0.135219 1.809409 0.623469 0.257382 -0.065126 -0.105062 1.552648 0.451969 1.175921 1.347885 1.103764 1.602674 1.302570 1.110770 -0.278442 0.117186 1.191533 1.769539 1.590915 1.859995 0.790536 1.201100 -0.026895 0.373169 -0.527751 0.339617 1.468978 0.777234 0.642679 0.958567 0.199955 0.006388 0.131257 0.182861 -0.064184) ) ;;; 112 prime -------------------------------------------------------------------------------- (vector 112 16.697049415765 #r(0 0 1 0 1 0 0 0 0 1 0 1 0 0 1 1 0 1 1 0 0 1 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1 1 0 0 0 0 0 0 1 1 0 1 0 1 1 1 0 0 1 0 1 0 0 0 0 1 0 1 0 0 0 0 0 1 1 1 0 1 1 0 0 1 1 0 1 0 0 0 1 0 0 1 0 1 0 0 1 0 1 0 1 0 0 1 0 0 0 1 1 0 1 1 1) - 13.804835 #r(0.000000 0.660626 0.012013 1.067055 1.731382 0.878320 0.900685 1.333334 0.681047 1.863220 1.352916 0.703854 1.515374 0.461716 0.898953 1.919840 0.286167 0.735654 -0.086197 0.617448 0.511110 1.353376 1.062165 1.636012 0.515505 1.399695 1.421287 -0.379478 0.731516 0.180102 1.567557 1.923199 -0.007316 1.368320 1.294564 0.578724 1.657029 0.985867 0.321763 1.643211 0.183594 -0.095598 1.792723 0.880687 0.335377 0.402596 1.614065 0.786600 0.590837 0.174605 0.357314 0.363837 -0.136455 0.186803 1.076928 1.936757 0.633832 1.217976 0.067642 0.078632 0.866945 1.729624 0.916168 1.228002 1.090442 0.162856 0.012895 1.357444 0.829157 1.905883 0.224325 1.392049 1.223672 1.768609 0.413025 0.871017 1.661030 1.831359 0.223665 1.475164 0.272068 0.564210 0.622152 1.113002 0.676345 -0.006078 1.737306 1.187465 0.535707 1.077110 1.810506 1.386823 0.000557 1.452387 1.030585 0.842150 -0.158625 1.174437 0.579578 -0.079023 1.196883 0.846201 0.482764 0.945473 0.701184 0.898505 0.170202 0.481114 0.605193 0.955521 -0.054086 0.358715) - - ;; 111+1 13.560854 #r(0.000000 0.996200 1.682628 0.999634 -0.183169 0.941340 -0.063380 1.872352 0.588785 0.718316 0.404204 0.564721 1.640073 1.488214 0.688322 1.540833 1.402097 0.325664 1.088557 1.271965 0.430614 -0.023931 1.082172 -0.819505 1.289052 1.272358 1.016703 0.615500 -0.063492 1.173776 1.419856 0.160057 0.471424 0.025687 0.794626 1.093604 1.347648 1.313640 0.365769 1.198433 1.539259 0.590650 1.625522 1.236869 1.255735 0.261849 0.614310 -0.133810 1.106507 0.525198 1.040282 1.242100 -0.009151 0.940124 1.120632 1.244098 1.583333 0.484225 0.270298 -0.091909 0.275038 0.915341 0.498191 1.846447 1.147765 0.805686 0.960525 1.293095 0.980148 0.249336 1.277364 0.859717 0.447170 0.347316 1.500244 0.749545 0.120155 1.639932 0.628998 0.242589 -0.052482 -0.149374 1.587211 0.461604 1.136482 1.323997 1.019660 1.587802 1.220439 1.097627 -0.381422 0.113408 1.209314 1.808025 1.585895 1.749582 0.823561 1.289475 0.074159 0.350519 -0.613785 0.308515 1.554187 0.783853 0.541355 0.955629 0.179584 0.128995 -0.001165 0.025208 -0.107472 -0.097625) + 13.487873 #r(0.000000 0.988576 1.686641 0.980319 -0.127170 0.967750 -0.065548 1.875209 0.600558 0.717992 0.381343 0.557607 1.609159 1.488983 0.683798 1.558477 1.432422 0.340470 1.077446 1.252886 0.469722 0.014736 1.095164 -0.817811 1.307853 1.305020 1.032969 0.618591 -0.044224 1.174555 1.388588 0.165690 0.427037 0.067238 0.781090 1.081157 1.327294 1.305105 0.352470 1.236751 1.548230 0.580647 1.616814 1.191785 1.268990 0.262187 0.629313 -0.205878 1.120559 0.510809 1.071598 1.276238 0.022982 0.876322 1.137508 1.220576 1.557652 0.510094 0.250405 -0.090350 0.302257 0.987320 0.436532 1.871222 1.176867 0.762537 0.963852 1.250204 0.993121 0.258751 1.275738 0.864771 0.426995 0.363147 1.460520 0.741741 0.119180 1.677866 0.685608 0.261943 -0.065562 -0.097389 1.627166 0.491093 1.112728 1.364171 1.004939 1.595611 1.217689 1.118702 -0.397754 0.109482 1.193955 1.818407 1.559795 1.764631 0.820077 1.306265 0.084979 0.314027 -0.624021 0.328352 1.563255 0.770548 0.538959 0.945484 0.209295 0.148112 -0.032998 -0.033887 -0.099531 -0.103879) ) ;;; 113 prime -------------------------------------------------------------------------------- (vector 113 16.203890830538 #r(0 1 0 1 0 0 1 1 1 1 0 1 1 1 1 1 0 1 0 0 0 0 0 1 0 1 0 0 1 1 1 0 0 1 1 0 1 0 1 0 1 1 0 1 0 1 1 0 0 0 1 0 1 0 1 1 1 1 1 1 0 0 0 1 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 0 1 1 1 0 1 1 0 0 1 0 1 1 0 1 0 0 1 0 0 0 1 0 1) 13.613456 #r(0.000000 0.554013 -0.189590 1.040342 1.895741 0.972257 1.983763 0.925350 1.413107 1.187039 0.890581 -0.092527 0.648924 0.275297 1.034974 0.578278 1.412961 1.217860 0.290211 0.146756 1.277989 1.797973 1.243546 0.309623 0.588952 0.766281 1.732300 0.158146 0.970241 1.057713 0.155581 0.740347 -0.278224 0.813051 0.090610 1.633987 0.141253 1.362430 1.811341 0.106172 0.560908 0.975141 0.414465 1.325189 1.317848 1.670918 1.310037 0.138103 1.544695 0.427642 0.688876 1.115251 0.104011 1.249484 1.283379 -0.217415 1.248803 -0.055143 1.377781 1.794050 -0.051929 -0.190679 -0.001958 1.872135 1.015649 0.017838 -0.117121 0.829495 -0.198380 0.905735 0.272607 0.619166 1.647347 0.816228 0.007369 0.650952 0.045714 0.308454 0.434057 0.201848 1.245915 0.933121 1.619736 1.351637 0.362509 1.868147 1.070766 1.188359 0.400988 0.049686 0.087230 0.628970 0.077489 1.262876 0.220162 0.869503 1.130712 0.267514 1.396227 1.721653 1.550102 1.446927 1.155950 0.841581 0.384623 1.977430 1.631746 0.006140 0.715062 1.236385 1.051311 0.995413 0.371400) + 13.555754 #r(0.000000 0.542883 -0.208339 1.077468 1.877641 0.990901 1.978968 0.933885 1.439573 1.156448 0.865512 -0.098009 0.625823 0.264216 1.038119 0.609446 1.464991 1.219573 0.246975 0.147215 1.255125 1.813430 1.249482 0.306525 0.585303 0.771188 1.723916 0.133907 0.989897 1.061218 0.167515 0.770641 -0.285533 0.853925 0.114470 1.640706 0.157607 1.379433 1.813084 0.129113 0.561455 0.977831 0.412527 1.307489 1.330465 1.668072 1.326928 0.127707 1.558817 0.411561 0.682997 1.116731 0.059794 1.267251 1.265071 -0.255846 1.213769 -0.095915 1.349824 1.785163 -0.075615 -0.199251 -0.038869 1.854336 0.996114 0.042902 -0.123450 0.842274 -0.197831 0.882948 0.249667 0.625795 1.676868 0.796423 -0.038863 0.646106 0.029141 0.269170 0.398108 0.173614 1.275005 0.934730 1.619284 1.385706 0.358183 1.899432 1.072819 1.178761 0.378151 0.029876 0.119180 0.630342 0.088987 1.233872 0.215431 0.853793 1.102846 0.274060 1.394926 1.693329 1.536442 1.426824 1.191483 0.838356 0.367540 1.965767 1.623670 0.030180 0.679081 1.253203 1.020423 0.979400 0.367307) ) ;;; 114 prime -------------------------------------------------------------------------------- (vector 114 16.442732865586 #r(0 0 1 1 0 0 1 1 0 0 0 0 1 1 1 0 1 0 1 1 0 0 0 0 0 1 1 1 1 0 1 1 1 1 1 0 1 1 0 0 1 0 1 1 1 1 1 0 0 0 0 1 0 1 0 0 1 0 1 1 1 0 1 0 0 0 0 1 0 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 1 1 1 1 0 0 0 0 0 1 1 1 0 1 1 0 1 0 0 1 0 1 0 0 0 1 0 0 1) - 14.166020 #r(0.000000 1.038356 0.826275 1.128674 -0.125090 1.829063 1.262013 1.160559 1.519516 1.502014 1.857796 1.525394 0.946893 1.361851 0.493317 1.621550 0.040839 0.825455 1.881008 1.165270 1.273827 0.159303 1.756090 1.393155 1.413051 0.957215 0.252091 1.226129 -0.094317 0.742943 1.002043 1.336572 1.592258 -0.082802 1.594640 0.366562 0.390860 1.427038 1.739079 0.663205 0.933325 1.484965 0.194283 0.375410 0.493300 0.605961 1.748551 0.279636 1.804517 0.357640 0.998348 0.681772 0.367098 0.467866 1.810315 1.933552 1.894370 1.189828 1.415118 1.834729 1.938426 1.415450 0.009074 1.747634 1.249287 0.770928 -0.115261 1.409451 1.246513 0.675514 1.266338 1.477875 -0.114148 0.185420 0.629532 1.098645 0.874254 0.446592 0.243371 0.516051 1.248852 0.028651 -0.007127 1.709807 1.312205 0.257361 1.279674 0.901557 0.855388 1.469222 1.328726 1.208217 1.433035 1.922664 0.274941 0.148828 0.367238 -0.254062 1.751340 0.773665 1.053171 0.567664 1.773987 1.113690 1.183578 1.066952 0.102607 0.071815 1.625657 1.255723 1.028659 0.085305 0.356288 0.418655) - - ;; 113+1 13.529505 #r(0.000000 0.609603 -0.150717 1.144620 1.885952 1.029695 -0.017328 1.023651 1.375935 1.049542 0.876959 -0.157071 0.712430 0.086142 1.092731 0.678537 1.443976 1.204147 0.360088 0.209607 1.268934 1.814390 1.230253 0.384833 0.625288 0.787682 1.706820 0.104070 0.975842 1.091508 0.162798 0.719194 -0.185681 0.851344 0.004406 1.551988 0.158850 1.400167 1.727125 0.074860 0.565161 0.958867 0.364724 1.349213 1.351889 1.679509 1.314199 0.132307 1.403589 0.369532 0.648564 1.160585 -0.009001 1.392847 1.218123 -0.146011 1.322032 -0.127699 1.286444 1.741589 -0.086769 -0.151954 0.062929 1.896116 1.063027 0.005563 -0.069693 0.819283 -0.185224 0.958608 0.217640 0.593867 1.814658 0.753485 -0.046094 0.586286 0.067659 0.127457 0.558174 0.155027 1.389478 0.905687 1.516935 1.472391 0.370204 1.903438 1.085058 1.201428 0.394426 0.093638 0.098055 0.586236 0.108735 1.290199 0.287019 0.975146 1.134274 0.275315 1.391551 1.689333 1.493530 1.402264 1.275785 0.772955 0.474442 0.009426 1.766587 0.112461 0.593436 1.228805 0.896377 1.061049 0.277890 -0.013199) + 13.496903 #r(0.000000 0.615575 -0.121130 1.113887 1.890200 1.003861 0.021145 1.017205 1.357046 1.032773 0.857385 -0.174619 0.699394 0.057507 1.100171 0.671318 1.408828 1.207097 0.382850 0.193294 1.290064 1.780192 1.224688 0.407517 0.662941 0.773377 1.723515 0.093904 0.960602 1.090815 0.155315 0.727319 -0.183707 0.818498 0.045744 1.594376 0.178880 1.393009 1.725840 0.066257 0.578042 0.906959 0.369884 1.357596 1.366685 1.699093 1.321035 0.156203 1.363280 0.336699 0.637601 1.164554 -0.017636 1.423056 1.225724 -0.157063 1.322611 -0.142337 1.301090 1.759907 -0.123519 -0.139198 0.062425 1.937146 1.093825 0.041121 -0.058305 0.803913 -0.159188 0.981425 0.193948 0.607832 1.864412 0.734381 -0.034995 0.599229 0.097000 0.070603 0.572735 0.132345 1.430214 0.952149 1.494010 1.446221 0.368850 1.905063 1.095553 1.216693 0.383585 0.119514 0.125237 0.592922 0.062308 1.267041 0.289511 0.975154 1.120353 0.239842 1.381315 1.723953 1.459888 1.409521 1.294945 0.764704 0.493131 -0.000595 1.807723 0.115880 0.557873 1.236774 0.866453 1.066783 0.273740 0.011321) ) ;;; 115 prime -------------------------------------------------------------------------------- (vector 115 16.774665887963 #r(0 1 0 0 0 1 0 0 0 1 0 0 0 0 1 0 0 0 1 0 1 1 1 0 0 0 0 0 1 0 0 0 1 1 0 1 0 0 1 0 0 1 0 1 0 0 1 1 0 0 0 1 1 1 0 0 0 0 0 1 0 0 1 1 1 1 1 1 1 1 0 0 0 1 0 0 0 1 1 0 0 1 0 0 1 0 0 0 1 0 1 0 1 0 0 0 0 0 1 1 1 0 0 1 1 0 1 1 0 1 1 1 0 1 0) - 14.106616 #r(0.000000 1.570092 0.362453 1.337474 0.264875 0.921400 0.355874 1.476538 0.382397 0.690102 0.627233 1.283297 1.585161 0.461353 0.250428 0.070613 -0.478768 0.954888 0.726879 1.251951 0.417891 0.945598 0.563852 0.084589 0.533104 0.472131 1.084144 1.608792 0.044337 1.518184 0.783171 0.484129 1.900804 -0.149622 0.399475 1.517825 0.218983 1.531509 -0.230530 0.567148 1.520162 -0.082961 1.681948 0.292123 0.756368 0.448131 1.473802 1.014666 -0.012646 1.572834 1.242744 0.425093 -0.031699 0.769537 1.112143 1.298398 0.333581 1.945824 -0.101577 1.894990 1.397266 1.272345 1.210062 1.810802 0.715502 0.534600 1.359024 1.288083 -0.103335 0.078475 0.156596 1.496646 1.076856 0.312782 0.361663 1.568537 1.496774 0.979145 1.697729 0.843520 0.130906 1.341892 0.946201 1.950539 0.684184 1.344931 0.821452 1.479748 1.308019 0.296269 1.793184 0.500147 0.839533 0.057599 0.886809 0.752434 1.587024 1.203157 1.022448 0.212093 1.492893 0.209714 0.165780 1.402030 -0.307350 0.474032 1.513784 1.517441 1.459089 1.632203 1.421380 1.032369 0.154966 0.002531 0.304007) - - ;; 114+1 13.732359 #r(0.000000 0.572178 -0.139025 0.983887 1.920434 1.123578 1.978353 0.968214 1.349051 1.117228 0.839675 -0.190533 0.694004 0.125250 1.107764 0.641260 1.405169 1.199788 0.276763 0.250348 1.204416 1.682914 1.257883 0.312057 0.695310 0.801198 1.682635 0.125698 0.950119 1.070718 0.245730 0.776193 -0.167540 0.949181 -0.042356 1.548062 0.106820 1.334788 1.742804 0.109905 0.567469 0.997715 0.375385 1.298162 1.314791 1.688434 1.235156 0.141282 1.427214 0.400188 0.631107 1.144708 -0.003109 1.362927 1.143332 -0.234998 1.276203 -0.143654 1.307422 1.689156 -0.014380 -0.262664 0.075462 1.880295 1.062640 0.101776 -0.026648 0.801460 -0.217311 0.971985 0.270988 0.672521 1.816202 0.778522 0.051104 0.549038 0.052885 0.201837 0.612616 0.180579 1.355932 0.900040 1.595492 1.482393 0.476525 1.886230 0.983641 1.114556 0.404677 0.048952 0.080076 0.569993 0.080539 1.262764 0.266797 0.946313 1.101489 0.203645 1.377876 1.725578 1.491484 1.434839 1.127583 0.826060 0.448266 0.008333 1.780636 0.098825 0.586600 1.122038 0.995066 1.017216 0.354291 0.057246 0.069092) + 13.635773 #r(0.000000 0.557429 -0.074944 0.985089 1.927230 1.161814 1.985693 0.974176 1.367223 1.100250 0.856971 -0.200153 0.642437 0.074046 1.139824 0.652779 1.411410 1.182061 0.287326 0.214642 1.194670 1.693342 1.275817 0.331966 0.668300 0.835748 1.663240 0.089441 0.977925 1.095087 0.248525 0.793913 -0.155186 0.960808 -0.067039 1.546271 0.105395 1.335240 1.702265 0.111365 0.554030 1.058295 0.390416 1.292533 1.253299 1.699722 1.208188 0.142252 1.464723 0.385798 0.656822 1.178399 -0.022683 1.401696 1.114936 -0.226670 1.299796 -0.159072 1.267671 1.682674 0.008241 -0.242381 0.106110 1.880152 1.042390 0.067718 -0.048438 0.804807 -0.204986 0.932801 0.213398 0.734055 1.765258 0.741302 0.034979 0.575207 0.120592 0.131683 0.539838 0.223928 1.346531 0.916165 1.633620 1.512271 0.457199 1.908918 0.974554 1.084873 0.371179 0.051019 0.068928 0.585032 0.105453 1.267744 0.247414 0.960058 1.083493 0.191406 1.382082 1.700715 1.488716 1.406717 1.130368 0.842364 0.433109 0.054201 1.841801 0.072130 0.552924 1.124686 1.007513 0.998212 0.308721 0.081786 0.109955) ) ;;; 116 prime -------------------------------------------------------------------------------- (vector 116 16.812931137234 #r(0 1 0 0 1 0 0 0 1 1 1 0 0 0 0 0 1 0 1 0 0 1 1 1 1 0 0 1 0 0 0 0 1 0 0 1 0 0 0 1 0 1 0 1 0 1 0 0 0 1 0 1 0 1 1 0 0 1 0 0 0 1 0 0 0 0 1 0 0 0 1 1 1 1 1 0 0 0 0 1 0 1 1 0 0 1 0 0 0 1 1 1 1 0 1 1 1 0 0 1 0 1 0 0 1 0 1 0 0 0 0 1 1 1 0 0) 13.782751 #r(0.000000 1.670105 0.303378 1.514771 0.060477 0.906403 0.370378 1.628880 0.301098 0.717479 0.564448 1.198544 1.701046 0.489974 0.092684 0.106689 -0.600359 0.960290 0.727113 1.181333 0.468036 0.933578 0.612714 0.102105 0.439119 0.536613 0.989488 1.668598 -0.080124 1.683573 0.654250 0.599004 1.870044 -0.069895 0.298556 1.555710 0.285805 1.565873 -0.205135 0.563645 1.519179 -0.152285 1.687696 0.402404 0.955645 0.241673 1.401865 1.046960 -0.019116 1.640885 1.197901 0.505391 0.095168 0.718441 1.181463 1.406618 0.309258 1.952979 -0.107329 1.969648 1.502137 1.090118 1.043918 1.702710 0.780485 0.583772 1.473922 1.490931 -0.163373 0.133574 0.135840 1.533071 1.015158 0.398692 0.320450 1.364722 1.538313 0.970480 1.636937 0.963390 0.136800 1.340905 1.204598 0.054477 0.486418 1.417827 0.808183 1.530254 1.191144 0.320075 1.853919 0.467453 0.809752 0.120164 0.781600 0.697424 1.379599 1.216021 0.948183 0.099657 1.566373 0.116729 -0.093843 1.319423 -0.420543 0.691568 1.660724 1.496943 1.401099 1.619305 1.446415 0.867038 0.105822 0.158044 0.282349 -0.011943) - 13.746058 #r(0.000000 1.672607 0.293480 1.507262 0.042368 0.900451 0.401286 1.623317 0.308674 0.726808 0.550286 1.191096 1.701665 0.491121 0.081955 0.125000 -0.579852 0.968360 0.715339 1.185061 0.487708 0.927342 0.609263 0.088527 0.427462 0.542852 0.977401 1.659263 -0.081161 1.693972 0.638302 0.619434 1.862972 -0.069867 0.307962 1.549750 0.290380 1.579837 -0.201369 0.557598 1.501821 -0.164349 1.688121 0.398995 0.978521 0.253532 1.407212 1.033809 -0.025129 1.625390 1.186929 0.499206 0.084216 0.709051 1.192206 1.419465 0.314322 1.944939 -0.110904 1.992193 1.523393 1.082403 1.053546 1.693512 0.788939 0.591513 1.476814 1.505817 -0.179583 0.124215 0.124954 1.540073 1.022442 0.396403 0.313403 1.346398 1.518205 0.956668 1.640049 0.946522 0.141681 1.340457 1.224736 0.050225 0.467109 1.416198 0.792789 1.558142 1.169028 0.323766 1.846052 0.465397 0.812638 0.124913 0.779066 0.681032 1.361378 1.219294 0.957516 0.090299 1.574931 0.117459 -0.119943 1.287347 -0.420178 0.692046 1.670070 1.491686 1.408821 1.626706 1.422023 0.851388 0.097174 0.172324 0.281089 -0.009460) + 13.663559 #r(0.000000 1.650661 0.241652 1.459945 -0.008369 0.883651 0.479431 1.601262 0.310686 0.742673 0.541328 1.221137 1.699606 0.513624 0.116403 0.088613 -0.593422 0.960937 0.698193 1.201052 0.514482 0.883539 0.640731 0.101358 0.411965 0.533904 0.932439 1.669314 -0.144377 1.683949 0.619701 0.680748 1.869685 -0.084881 0.367803 1.571320 0.300669 1.615428 -0.153370 0.548239 1.481415 -0.156635 1.723139 0.385794 1.050140 0.293843 1.424839 0.966614 -0.064409 1.576813 1.171538 0.470866 0.042403 0.672774 1.211184 1.458892 0.291776 1.896419 -0.083851 0.070795 1.577682 1.069933 1.033627 1.669378 0.802828 0.657355 1.557455 1.502397 -0.226178 0.072054 0.103947 1.551808 1.021959 0.372650 0.310847 1.244016 1.482074 0.940184 1.684630 0.940207 0.185260 1.316082 1.247272 0.057567 0.465227 1.450910 0.773952 1.584687 1.118280 0.316520 1.843715 0.506745 0.872016 0.140454 0.753675 0.657720 1.341600 1.247077 0.941481 0.088473 1.618860 0.124010 -0.181112 1.281707 -0.443145 0.694319 1.686598 1.451031 1.457478 1.625031 1.389635 0.831994 0.089417 0.176160 0.314770 -0.001482) ) ;;; 117 prime -------------------------------------------------------------------------------- (vector 117 17.5997 #r(0 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 1 0 1 1 0 0 0 1 0 1 0 1 1 0 0 0 0 0 0 0 1 0 1 0 1 1 0 1 1 0 0 1 0 1 0 0 0 0 0 1 0 1 0 0 0 0 1 1 1 1 0 1 0 1 0 0 1 1 1 1 0 0 0 0 1 0 1 0 1 1 1 1 1 0 1 0 1 0 0 1 0 1 0 1 1 0 1 0 1 1 0 1 1 0 1 1 1 1 0 0 1) 13.889211 #r(0.000000 1.679442 0.299199 1.367111 0.052770 0.927297 0.328215 1.615881 0.302404 0.707696 0.516039 1.151316 1.673258 0.534217 0.190986 0.074151 -0.598397 0.913919 0.765928 1.260413 0.423264 1.023745 0.609735 0.153506 0.453539 0.468256 1.018228 1.788765 -0.068307 1.692855 0.624116 0.609141 1.910624 -0.022395 0.256365 1.514074 0.233219 1.516754 -0.154609 0.590788 1.514050 -0.043651 1.742187 0.341087 0.951970 0.371363 1.447587 1.079612 0.057107 1.623815 1.214707 0.567773 0.057804 0.791128 1.221209 1.383201 0.340554 -0.013292 -0.005609 1.947264 1.370803 1.062963 1.024336 1.739421 0.767066 0.671699 1.426918 1.511148 -0.149781 0.104225 0.061945 1.535119 0.940075 0.392689 0.259023 1.411809 1.598917 0.941897 1.683270 0.884953 0.108874 1.319701 1.100749 -0.050961 0.639728 1.429813 0.861586 1.511163 1.232212 0.240917 1.860927 0.406637 0.844627 0.125914 0.873615 0.651653 1.385473 1.135755 0.994702 0.030143 1.590457 0.161005 0.055154 1.334956 -0.459106 0.663912 1.678280 1.514956 1.365867 1.519273 1.441132 0.891112 0.176832 0.115181 0.351957 -0.175561 0.176948) - 13.855613 #r(0.000000 1.681486 0.280277 1.372863 0.039811 0.923187 0.345445 1.622414 0.299410 0.705089 0.500904 1.140403 1.689089 0.537966 0.200511 0.083469 -0.597715 0.906078 0.765251 1.255746 0.416283 1.033158 0.610496 0.149116 0.449236 0.473041 1.015991 1.789578 -0.073971 1.695857 0.625526 0.611850 1.909543 -0.035786 0.239670 1.508449 0.223759 1.501792 -0.166750 0.580430 1.500440 -0.033426 1.751646 0.346410 0.950898 0.370703 1.449166 1.084877 0.063348 1.613017 1.241015 0.570366 0.041864 0.780784 1.222604 1.375172 0.344781 -0.022845 0.009809 1.949964 1.359174 1.052049 1.031691 1.729662 0.773761 0.657956 1.430138 1.535960 -0.152674 0.104935 0.058928 1.535332 0.936081 0.406630 0.265170 1.400452 1.604481 0.949793 1.689890 0.878083 0.101940 1.312258 1.109729 -0.055437 0.636423 1.422014 0.867874 1.517456 1.225692 0.242914 1.878002 0.400641 0.840606 0.118717 0.878192 0.656925 1.378873 1.126623 1.010958 0.037236 1.593290 0.138879 0.055639 1.325678 -0.454889 0.665818 1.677341 1.516589 1.365703 1.532753 1.429426 0.882225 0.176333 0.126931 0.358829 -0.184146 0.208578) + 13.801679 #r(0.000000 1.697781 0.296765 1.370360 0.020414 0.896348 0.372064 1.629584 0.326445 0.679396 0.448560 1.139247 1.712198 0.482946 0.210468 0.104554 -0.608245 0.890472 0.787445 1.271537 0.417286 1.062878 0.610245 0.193311 0.420377 0.464460 0.998214 1.800620 -0.064275 1.720669 0.644077 0.661171 1.894085 -0.059007 0.170769 1.487136 0.238382 1.473405 -0.206244 0.542360 1.485922 -0.025847 1.750993 0.347982 0.941668 0.391889 1.449329 1.091471 0.061994 1.591556 1.290215 0.589840 0.023483 0.730284 1.249775 1.368847 0.360279 -0.062613 0.033459 1.964418 1.361216 1.013219 1.014108 1.762385 0.776033 0.651174 1.416593 1.591599 -0.162448 0.151378 0.077571 1.566802 0.920871 0.422812 0.235020 1.388073 1.623814 0.933724 1.700556 0.911554 0.107218 1.317702 1.124565 -0.048699 0.614109 1.402906 0.820506 1.482550 1.191101 0.285129 1.874660 0.392212 0.834853 0.129917 0.861631 0.648285 1.345908 1.124613 1.019816 -0.015656 1.604612 0.140068 0.034354 1.277055 -0.470292 0.686895 1.637131 1.548998 1.350419 1.523425 1.451535 0.841907 0.183547 0.135184 0.342354 -0.206889 0.262389) ) ;;; 118 prime -------------------------------------------------------------------------------- (vector 118 17.181785583496 #r(0 0 0 1 0 0 1 1 1 0 0 0 1 0 0 1 0 0 0 1 0 1 1 1 1 1 0 1 1 1 0 1 0 1 0 0 0 0 1 1 0 1 1 1 0 0 0 1 1 0 0 0 0 1 1 1 0 0 0 0 0 1 1 1 0 1 1 0 1 0 0 0 1 1 1 1 0 0 1 1 1 1 1 0 1 1 0 0 0 1 1 1 0 1 0 1 0 1 1 0 0 0 1 1 0 0 0 0 1 0 1 1 0 0 1 0 1 0) 13.955663 #r(0.000000 1.656893 0.312860 1.406022 0.045609 0.940726 0.323204 1.558622 0.313593 0.699110 0.536076 1.119751 1.657613 0.469730 0.215020 0.137907 -0.614064 0.902352 0.821797 1.171991 0.441310 1.059221 0.661850 0.277594 0.394536 0.546400 0.968850 1.793240 -0.073575 1.622506 0.677941 0.641837 1.952355 -0.044282 0.215122 1.490798 0.302768 1.506837 -0.235108 0.508030 1.520891 -0.097109 1.755394 0.256002 1.007243 0.327520 1.464098 1.079175 0.017892 1.590910 1.290254 0.601225 -0.032662 0.654468 1.229419 1.312262 0.353655 -0.032649 0.034883 1.896617 1.433210 1.047605 1.126390 1.674282 0.764405 0.618210 1.508232 1.671380 -0.173491 0.106521 0.149565 1.507742 0.949278 0.443666 0.317362 1.314645 1.634673 0.873102 1.588608 0.915021 0.172843 1.351037 1.151673 -0.042685 0.619993 1.550214 0.823729 1.429222 1.211772 0.248747 1.864022 0.374155 0.849134 0.123908 0.792603 0.736151 1.435290 1.198233 1.078587 0.058874 1.626102 0.122469 0.017624 1.330950 -0.499655 0.706598 1.629594 1.438050 1.370171 1.549897 1.430173 0.915025 0.119087 0.070759 0.413439 -0.125417 0.236481 -0.031842) - 13.910626 #r(0.000000 1.668279 0.335142 1.402632 0.026021 0.951995 0.317224 1.589827 0.323500 0.697131 0.533248 1.105642 1.661404 0.452965 0.211918 0.153131 -0.604835 0.902391 0.817199 1.165616 0.454953 1.091998 0.658669 0.310656 0.385028 0.572454 0.989828 1.828318 -0.092689 1.645771 0.697147 0.645720 1.995588 -0.058244 0.223912 1.456783 0.313711 1.519472 -0.230646 0.485578 1.520907 -0.067700 1.740126 0.264744 0.980287 0.344519 1.487959 1.089008 0.006571 1.583565 1.279098 0.601486 -0.023772 0.648639 1.232460 1.321576 0.349967 -0.042254 0.037541 1.909313 1.419865 1.028721 1.122824 1.660150 0.747333 0.620923 1.520282 1.670984 -0.171577 0.118812 0.138765 1.489537 0.964108 0.437907 0.322555 1.306289 1.626552 0.884874 1.604890 0.919536 0.191435 1.356025 1.135291 -0.040848 0.614927 1.555357 0.811548 1.427272 1.221956 0.259782 1.850220 0.409165 0.864489 0.126618 0.788988 0.747834 1.446037 1.205928 1.084800 0.050411 1.649401 0.134962 -0.006238 1.314127 -0.503144 0.708232 1.619484 1.488817 1.384563 1.574732 1.419606 0.877305 0.115158 0.086883 0.428354 -0.116246 0.249558 -0.077787) + 13.831508 #r(0.000000 1.657708 0.395500 1.391206 -0.008498 0.968710 0.375987 1.567310 0.345657 0.733272 0.524800 1.117593 1.664050 0.446518 0.218396 0.142353 -0.577464 0.870519 0.779518 1.232172 0.431535 1.160027 0.728797 0.361626 0.422033 0.554334 0.983113 1.861390 -0.127927 1.660761 0.657546 0.617890 0.057461 -0.094851 0.272154 1.430494 0.291275 1.490636 -0.216706 0.455161 1.481532 -0.061445 1.774317 0.265505 0.942077 0.402456 1.499803 1.076951 -0.001076 1.589928 1.312902 0.622517 -0.002447 0.679389 1.250462 1.367420 0.355028 -0.066444 0.017314 1.921257 1.363796 0.990354 1.162513 1.606406 0.747472 0.674614 1.523838 1.645992 -0.165785 0.122006 0.142329 1.433731 0.943791 0.467370 0.324452 1.286173 1.667632 0.893169 1.646689 0.959699 0.169777 1.347458 1.184795 -0.033739 0.662841 1.540071 0.743515 1.398479 1.205864 0.340887 1.846305 0.486109 0.913392 0.072505 0.863596 0.796557 1.404615 1.245824 1.129468 0.125104 1.665643 0.096891 -0.002019 1.356251 -0.462439 0.740344 1.611939 1.486142 1.409188 1.605810 1.353705 0.887504 0.151519 0.093719 0.452833 -0.142740 0.284959 -0.125104) ) ;;; 119 prime -------------------------------------------------------------------------------- (vector 119 17.167841346875 #r(0 1 0 1 1 1 1 0 0 1 0 1 0 0 1 1 1 1 0 0 1 1 1 1 1 0 1 1 1 1 1 0 1 0 0 0 0 1 1 1 0 1 0 0 1 0 1 1 1 1 0 1 0 0 1 1 1 1 1 0 0 1 0 0 1 0 0 0 0 0 1 1 1 0 1 1 0 1 1 1 1 0 0 0 0 0 1 0 1 0 0 0 0 1 1 0 0 1 0 0 1 0 1 1 1 1 1 1 0 0 0 1 1 0 1 1 0 1 1) 14.018618 #r(0.000000 1.667367 0.322872 1.356274 0.058995 0.960979 0.391067 1.596203 0.294396 0.668831 0.482386 1.201983 1.684789 0.511518 0.202150 0.119421 -0.566103 0.969879 0.710276 1.185777 0.439002 1.081943 0.730732 0.236637 0.526675 0.480731 1.028367 1.739731 -0.138846 1.593254 0.713861 0.553938 1.957692 0.049573 0.238503 1.491899 0.251089 1.428730 -0.126673 0.452175 1.482756 -0.053077 1.780248 0.323594 0.960159 0.318559 1.403830 1.045323 0.072970 1.671965 1.340192 0.627012 0.093313 0.726626 1.260031 1.369364 0.271099 0.039064 -0.011301 1.960494 1.463622 1.056374 1.121811 1.627859 0.817517 0.663209 1.409881 1.612732 -0.152806 0.038886 0.274896 1.521348 0.915556 0.404329 0.221685 1.199737 1.694611 0.915335 1.572323 0.961485 0.112089 1.311173 1.127868 -0.177640 0.609597 1.415894 0.807680 1.506084 1.239635 0.162405 1.866700 0.317949 0.857946 0.112683 0.879435 0.694750 1.339170 1.270491 1.111213 0.092592 1.497893 0.151420 0.069449 1.319832 -0.496262 0.680555 1.680836 1.536147 1.322680 1.555058 1.410956 0.888418 0.228998 0.018175 0.403145 -0.128572 0.219741 -0.075154 -0.155224) - 13.905721 #r(0.000000 1.722601 0.352202 1.400873 0.035058 0.956275 0.372047 1.593661 0.315993 0.635053 0.451591 1.232425 1.656272 0.502944 0.227041 0.124602 -0.568215 0.972791 0.680638 1.226818 0.442830 1.122644 0.742839 0.307719 0.523157 0.461450 0.990418 1.699138 -0.168895 1.575739 0.690280 0.492266 1.970943 0.061864 0.243973 1.512814 0.290265 1.448081 -0.100349 0.440787 1.486276 -0.046596 1.821813 0.326788 0.953386 0.290450 1.398237 1.058161 0.067062 1.638534 1.316229 0.606944 0.141915 0.708689 1.260638 1.344199 0.274926 0.031733 -0.001759 1.976169 1.457742 1.054827 1.177364 1.610891 0.834352 0.644530 1.408423 1.632758 -0.200852 0.053036 0.301211 1.530969 0.888019 0.396620 0.244835 1.112809 1.680593 0.887994 1.578468 1.037207 0.113334 1.278663 1.148153 -0.229779 0.572328 1.390638 0.768364 1.506121 1.249808 0.158743 1.878762 0.271081 0.840968 0.108466 0.873784 0.730942 1.247475 1.233040 1.130141 0.115968 1.504034 0.166101 0.048558 1.302733 -0.511170 0.711165 1.671305 1.533379 1.358034 1.553446 1.392508 0.887784 0.263931 -0.031609 0.485764 -0.105578 0.204644 -0.078196 -0.169586) + 13.833654 #r(0.000000 1.775269 0.352407 1.436521 0.038986 0.928616 0.356152 1.550964 0.357392 0.584704 0.418177 1.213014 1.640263 0.468110 0.223981 0.132081 -0.588649 0.984729 0.646836 1.228161 0.470845 1.133668 0.761163 0.321370 0.517163 0.456279 1.020097 1.675965 -0.155040 1.532607 0.681605 0.532045 0.020639 0.117064 0.211109 1.551701 0.300920 1.462544 -0.092735 0.417227 1.442691 -0.060243 1.867647 0.348128 1.038248 0.270946 1.397204 1.086487 0.097045 1.628291 1.299291 0.635218 0.136653 0.610222 1.257483 1.342083 0.240280 -0.007651 0.016298 1.986041 1.470712 0.981426 1.209866 1.594606 0.825037 0.663152 1.379143 1.657217 -0.223608 0.070703 0.304044 1.570486 0.853396 0.425057 0.256228 1.045091 1.677765 0.888062 1.613218 1.048349 0.122408 1.238201 1.103859 -0.302085 0.567872 1.323304 0.716054 1.555264 1.203678 0.120467 1.917957 0.221332 0.861625 0.120149 0.921977 0.749359 1.275425 1.195092 1.168199 0.179587 1.443846 0.130578 0.023615 1.315666 -0.547701 0.703913 1.688926 1.509555 1.392962 1.571546 1.358123 0.917693 0.230658 -0.085173 0.489619 -0.105304 0.209193 -0.033167 -0.156261) ) ;;; 120 prime -------------------------------------------------------------------------------- (vector 120 17.067 #r(0 1 0 1 1 1 0 1 0 0 1 0 0 1 0 0 0 0 0 1 1 1 0 1 0 1 0 1 1 1 0 0 1 1 1 1 0 1 1 1 0 1 0 1 0 1 0 1 1 1 1 1 1 0 1 0 1 1 1 0 1 1 0 1 1 0 0 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 1 1 0 0 1 1 1 1 1 1 0 0 1 1 0 0 0 1 0 0 0 0 1 0 0 0 0 1 1 0 1 1 0 1 0 0 1 0) 14.042466 #r(0.000000 1.695702 0.296711 1.338908 -0.078265 1.044647 0.445401 1.570773 0.356080 0.726875 0.562835 1.121698 1.696368 0.511401 0.207025 0.089500 -0.565140 0.942644 0.652808 1.167682 0.412919 0.987661 0.705879 0.198820 0.440865 0.512441 1.083421 1.751114 -0.069762 1.661970 0.763824 0.509555 1.981466 0.038582 0.269865 1.492095 0.267412 1.351405 -0.147933 0.429115 1.485596 -0.131353 1.737203 0.373649 0.934842 0.295981 1.401570 1.025505 0.159868 1.751013 1.267064 0.606930 0.033477 0.655345 1.307003 1.298431 0.292781 -0.055933 0.016301 1.947579 1.426247 1.012103 1.014686 1.610683 0.794183 0.636102 1.398468 1.630487 -0.106933 0.019245 0.234173 1.454561 0.871538 0.489427 0.182807 1.191314 1.653186 0.812730 1.596587 0.968349 0.144419 1.254337 1.168160 -0.201543 0.642098 1.430541 0.891933 1.544951 1.231299 0.070309 1.961946 0.325740 0.895972 0.097452 0.983847 0.726652 1.390398 1.237569 1.108864 0.162933 1.463000 0.108857 0.104118 1.340850 -0.457424 0.750886 1.757915 1.530952 1.370214 1.508778 1.434766 0.846018 0.114800 0.004043 0.307829 -0.143116 0.279204 -0.090078 -0.107619 0.067028) - 13.884729 #r(0.000000 1.690378 0.243521 1.382485 -0.063999 1.055343 0.499982 1.556414 0.314120 0.664261 0.582078 1.145064 1.739074 0.494367 0.154653 0.096360 -0.482885 0.990940 0.540858 1.125427 0.449878 1.054825 0.767961 0.235972 0.411868 0.490859 1.140212 1.741461 -0.029476 1.713434 0.728771 0.612567 1.947468 0.065027 0.264240 1.518107 0.232394 1.407644 -0.149075 0.413009 1.385306 -0.138265 1.659847 0.394852 0.963054 0.230844 1.395938 0.989342 0.217420 1.831746 1.211383 0.668278 -0.022165 0.542364 1.349769 1.330051 0.372466 -0.054967 0.048807 0.016933 1.408986 1.013898 0.909611 1.589332 0.757512 0.650600 1.392858 1.675535 -0.129245 -0.049822 0.216969 1.425353 0.795259 0.580815 0.088186 1.065448 1.657950 0.840615 1.592049 0.956685 0.187055 1.265886 1.159422 -0.146949 0.593681 1.377428 0.906719 1.600380 1.145876 0.114755 -0.016372 0.320092 0.910983 0.087267 0.989993 0.694642 1.420729 1.287115 1.156472 0.150248 1.398947 0.122750 0.073842 1.298151 -0.514319 0.797877 1.803600 1.508665 1.409117 1.468124 1.497838 0.760472 0.103508 -0.048861 0.262161 -0.162741 0.239393 -0.142178 -0.117649 0.058937) + 13.817800 #r(0.000000 1.700289 0.207360 1.395205 -0.039015 1.048640 0.516240 1.506405 0.300955 0.665188 0.581217 1.138667 1.813000 0.525902 0.105435 0.101016 -0.470878 0.971644 0.491260 1.133324 0.495951 1.051681 0.854623 0.281077 0.405689 0.499352 1.159779 1.760073 0.014547 1.737164 0.727052 0.663371 1.870361 0.073718 0.286205 1.548832 0.176825 1.374664 -0.191380 0.405430 1.334275 -0.098576 1.634835 0.411998 0.991777 0.174465 1.439378 1.004942 0.270139 1.840639 1.151965 0.702101 -0.059908 0.532133 1.308270 1.278360 0.354166 -0.021937 0.053929 0.063829 1.362727 0.986710 0.857743 1.586978 0.746449 0.639605 1.375355 1.727772 -0.172580 -0.035787 0.185602 1.436241 0.740247 0.693727 0.058134 1.012043 1.645800 0.815108 1.565916 0.993454 0.226730 1.317761 1.159138 -0.137997 0.612042 1.390189 0.892305 1.636516 1.106572 0.111661 -0.012154 0.373177 0.932302 0.099568 1.041644 0.650168 1.470937 1.311652 1.163502 0.181018 1.408366 0.129544 0.057691 1.321963 -0.544407 0.802903 1.820809 1.528562 1.448992 1.381093 1.496807 0.786841 0.122308 -0.055446 0.280126 -0.193147 0.238596 -0.109895 -0.127384 0.038052) ) ;;; 121 prime -------------------------------------------------------------------------------- (vector 121 17.782977183017 #r(0 0 1 0 1 0 0 1 1 1 0 1 1 0 0 0 0 1 1 0 0 0 1 0 0 0 0 1 1 1 1 0 1 1 1 0 0 1 1 1 1 0 0 1 0 1 0 0 0 1 0 0 0 0 0 1 0 0 0 1 0 1 1 0 1 0 0 0 1 1 0 1 0 0 0 0 0 1 0 1 1 1 0 1 1 1 1 0 0 0 0 1 1 1 0 1 0 1 0 0 1 1 0 1 0 0 0 0 0 1 1 0 0 0 1 0 1 0 1 0 0) 14.145310 #r(0.000000 -0.025891 1.793636 0.033424 0.540007 1.698366 1.937124 -0.609559 0.386368 0.372251 1.167122 0.009884 1.449702 0.151646 0.129257 0.221923 0.286263 0.194141 1.256596 -0.022208 0.587239 1.364223 1.036771 0.840539 0.300738 0.487086 1.849878 -0.356013 -0.244608 -0.042719 1.244769 1.401449 0.301842 1.027056 1.091793 0.623370 1.184562 0.517907 0.649838 0.331082 0.619154 1.467356 0.525086 0.836576 0.132708 0.186394 1.646954 1.207107 -0.124102 1.434383 0.438192 1.403615 1.086842 1.456374 0.098749 0.654033 1.469902 -0.092397 0.999549 0.914715 1.334656 0.842194 0.762721 1.400578 1.518574 1.628966 0.557815 0.576931 -0.575198 0.632751 1.009717 1.185394 -0.060402 1.274789 1.032399 -0.216393 1.814193 1.597562 0.558478 0.044897 1.319287 0.285577 -0.020660 1.082584 0.821657 1.849151 0.241943 0.297525 1.569624 1.593287 0.604518 1.347238 0.159734 0.361474 0.136103 1.298636 0.140131 1.192829 1.398339 0.674275 0.995843 0.943454 0.693721 0.589259 1.642401 1.051611 -0.266130 0.115428 0.439245 0.514540 1.691776 1.063362 0.306592 0.883309 1.563638 -0.186910 0.971866 0.448146 0.177042 1.080065 0.466207) - 13.914611 #r(0.000000 -0.012207 1.731588 0.082333 0.569031 1.640690 1.876556 -0.642132 0.426439 0.398197 1.169331 0.158529 1.458876 0.095494 0.083175 0.160128 0.284629 0.165930 1.282328 -0.041773 0.655327 1.447466 1.006560 0.769593 0.379137 0.543513 1.883950 -0.328912 -0.335355 -0.171199 1.291584 1.458482 0.222495 0.939568 1.138263 0.641369 1.198731 0.457092 0.621940 0.321264 0.592427 1.453721 0.572512 0.955480 0.051660 0.139942 1.669163 1.224274 -0.138813 1.347163 0.437138 1.396280 1.029358 1.461066 0.032706 0.597223 1.352927 -0.017490 0.966845 1.003634 1.380464 0.846252 0.681578 1.383639 1.598446 1.662778 0.625626 0.643620 -0.594059 0.705618 1.037227 1.145267 -0.117136 1.311349 1.077845 -0.273011 1.896584 1.580603 0.559620 0.104085 1.315823 0.219319 0.024263 1.041054 0.890257 1.854532 0.243530 0.275763 1.674434 1.634426 0.549039 1.313854 0.171782 0.390579 0.118468 1.333353 0.178790 1.197999 1.377488 0.735763 0.984519 0.968672 0.675814 0.590784 1.612841 0.975724 -0.314052 0.120529 0.374863 0.440006 1.753829 1.139580 0.334123 0.903011 1.607809 -0.149515 0.879914 0.479639 0.168752 1.069953 0.513553) + 13.908333 #r(0.000000 0.000891 1.695074 0.106532 0.569637 1.655372 1.865245 -0.629596 0.452497 0.403388 1.159425 0.160162 1.445064 0.084861 0.059805 0.176925 0.276214 0.179512 1.291855 -0.049489 0.712727 1.458576 0.986917 0.775639 0.389347 0.573050 1.893876 -0.352158 -0.355659 -0.185185 1.323576 1.458551 0.231978 0.943414 1.152287 0.624047 1.165673 0.436685 0.608894 0.336002 0.588032 1.494217 0.580954 0.987230 0.019537 0.121516 1.691256 1.209603 -0.151187 1.364054 0.435562 1.386297 1.029706 1.445773 0.027263 0.562752 1.350682 -0.002670 0.974559 1.005980 1.399191 0.817995 0.675684 1.358104 1.580031 1.696840 0.644332 0.642648 -0.596980 0.713980 1.029296 1.126220 -0.133753 1.295080 1.099164 -0.296575 1.930643 1.573571 0.537105 0.084910 1.286456 0.201698 0.033414 1.031041 0.874177 1.896479 0.268050 0.300998 1.687580 1.653673 0.534305 1.305676 0.179150 0.355690 0.099882 1.300262 0.183402 1.204704 1.384428 0.733816 0.957872 0.967895 0.683568 0.602088 1.611798 0.913804 -0.326742 0.118995 0.358899 0.438212 1.736322 1.140694 0.335172 0.892431 1.579283 -0.161959 0.873904 0.456296 0.141535 1.048073 0.510191) ) ;;; 122 prime -------------------------------------------------------------------------------- @@ -3203,49 +3196,49 @@ ;; from 121+1 14.077769 #r(0.000000 -0.102882 1.749236 -0.004117 0.483853 1.765874 1.938255 -0.600392 0.405831 0.339694 1.084448 1.949979 1.449950 0.179825 0.196465 0.250508 0.230057 0.267538 1.186702 -0.013547 0.609348 1.275263 1.002412 0.929479 0.351264 0.550827 1.866085 -0.207369 -0.221459 -0.043981 1.181650 1.372732 0.322165 0.950666 1.016902 0.608561 1.206924 0.503654 0.566235 0.334378 0.545128 1.400875 0.599963 0.865496 0.228459 0.195440 1.563459 1.162224 -0.092823 1.463200 0.340144 1.432985 0.949791 1.498279 0.068471 0.623276 1.392543 -0.178909 0.913012 0.880422 1.353490 0.813253 0.747974 1.430440 1.480413 1.631261 0.640181 0.621156 -0.581884 0.645199 1.046241 1.177765 0.048757 1.254481 1.019786 -0.266200 1.761071 1.575419 0.546658 -0.000712 1.213661 0.352510 -0.036380 1.089333 0.735910 1.940744 0.321816 0.327061 1.683870 1.638125 0.601090 1.278317 0.270163 0.360522 0.023473 1.250704 0.243204 1.199993 1.329172 0.588810 0.966119 0.939463 0.761317 0.553614 1.599868 1.062777 -0.228048 0.241966 0.388550 0.647592 1.729999 1.118550 0.325131 0.887699 1.516026 -0.170170 1.006043 0.421332 0.259983 1.062250 0.497913 0.166635) - 13.951469 #r(0.000000 -0.103235 1.758441 0.059759 0.516254 1.776922 1.933895 -0.591444 0.466182 0.388849 1.072534 1.959020 1.500644 0.173627 0.149773 0.298701 0.215274 0.315768 1.240310 0.004604 0.706606 1.276231 0.996771 0.902606 0.318521 0.578070 1.946147 -0.176908 -0.288116 -0.091527 1.163799 1.357445 0.320092 0.931841 1.025717 0.539905 1.146371 0.447220 0.527730 0.297728 0.514945 1.428658 0.598771 0.901057 0.168055 0.233385 1.541159 1.265332 -0.083167 1.444304 0.353589 1.426078 0.978635 1.514840 0.054456 0.629132 1.379720 -0.221873 0.910733 0.901555 1.399929 0.828178 0.730041 1.430518 1.484626 1.654793 0.669264 0.657260 -0.569553 0.669545 1.061998 1.146843 0.065017 1.252494 1.041767 -0.309645 1.784518 1.589358 0.526967 0.045897 1.199138 0.344641 0.009005 1.057779 0.765265 1.928568 0.295211 0.285641 1.676113 1.648807 0.608253 1.270702 0.230753 0.341631 0.070322 1.283565 0.304167 1.216472 1.293689 0.579828 0.944450 0.906163 0.760942 0.510010 1.622333 1.034008 -0.250296 0.250573 0.360957 0.617110 1.779657 1.073859 0.346418 0.901218 1.488367 -0.229735 1.004386 0.448012 0.240328 1.017721 0.522914 0.252217) + 13.931719 #r(0.000000 -0.101488 1.751272 0.055778 0.530392 1.759014 1.928821 -0.616774 0.476279 0.379370 1.046953 1.992414 1.515877 0.160867 0.121876 0.327912 0.244384 0.280180 1.253010 -0.006602 0.742124 1.290261 0.987154 0.900555 0.317307 0.592114 1.955317 -0.170270 -0.302964 -0.132621 1.162009 1.395564 0.324028 0.927958 1.047000 0.547965 1.141668 0.477742 0.519466 0.299103 0.489704 1.381927 0.598552 0.886162 0.165386 0.215899 1.573347 1.270651 -0.112011 1.412553 0.388633 1.426732 0.970990 1.523887 0.056579 0.618426 1.371102 -0.192299 0.877821 0.891660 1.429589 0.869995 0.734937 1.404285 1.464616 1.673196 0.697074 0.650001 -0.569800 0.691542 1.060767 1.144519 0.065879 1.288165 1.034294 -0.359056 1.790371 1.566656 0.539017 0.046901 1.179963 0.322640 0.011870 1.056882 0.791564 1.924595 0.313725 0.253516 1.695775 1.605967 0.620648 1.272429 0.216608 0.328898 0.085695 1.291500 0.326852 1.211413 1.293284 0.593336 0.954372 0.936785 0.759024 0.526190 1.620897 1.024318 -0.258806 0.275640 0.331822 0.574279 1.751381 1.076852 0.374650 0.916001 1.505624 -0.242937 1.025954 0.475401 0.198728 1.031720 0.551229 0.245711) ) ;;; 123 prime -------------------------------------------------------------------------------- (vector 123 17.273 #r(0 0 0 0 0 0 1 0 1 1 1 0 0 0 1 0 1 0 0 1 1 0 1 0 0 0 0 0 0 0 0 1 1 1 1 1 0 1 1 1 0 1 0 0 1 0 1 1 0 1 0 1 1 0 1 0 0 1 1 0 0 0 1 1 1 1 0 1 1 0 1 1 0 1 0 1 1 1 1 1 0 1 1 1 1 0 0 0 1 1 0 1 1 1 1 1 1 1 1 0 1 0 1 0 0 0 1 0 0 1 0 1 1 1 0 1 0 1 0 0 1 0 0) 14.218431 #r(0.000000 -0.071277 1.809148 -0.020616 0.407111 1.755823 1.904945 -0.715971 0.341233 0.449964 1.085208 0.031030 1.532200 0.268807 0.148267 0.268084 0.272209 0.202242 1.223891 -0.064002 0.629461 1.331632 1.050525 0.887285 0.370000 0.565442 1.910419 -0.226719 -0.262129 -0.049320 1.111879 1.377442 0.321129 0.921437 0.982936 0.703155 1.229920 0.446816 0.492798 0.314076 0.541522 1.414758 0.522185 0.801174 0.218712 0.168371 1.631951 1.208384 -0.085808 1.408101 0.423643 1.324899 0.982011 1.466628 0.095538 0.635570 1.314596 -0.072617 1.020892 0.911989 1.330565 0.770391 0.725410 1.510974 1.479974 1.759621 0.639552 0.614948 -0.510015 0.641435 0.965296 1.113277 0.074254 1.206499 1.003706 -0.366482 1.772703 1.570225 0.592942 0.091270 1.226107 0.311704 0.007633 0.964361 0.718780 1.974845 0.242071 0.343141 1.709800 1.693786 0.483738 1.265900 0.338851 0.340533 0.047929 1.263159 0.240281 1.186223 1.427920 0.613439 0.969107 0.960914 0.712662 0.596951 1.686986 1.021249 -0.262802 0.214377 0.402786 0.561682 1.740484 1.058116 0.341115 0.933358 1.469760 -0.231395 1.023135 0.404403 0.200269 1.060708 0.484072 0.072981 0.045518) - 14.044608 #r(0.000000 -0.072849 1.804855 -0.026820 0.403218 1.732811 1.848355 -0.805115 0.402505 0.458030 1.086499 0.037726 1.560470 0.307115 0.142953 0.341422 0.256960 0.145940 1.254789 -0.148667 0.656840 1.337033 1.078029 0.942567 0.337222 0.594606 1.984015 -0.253471 -0.335961 -0.067260 1.103773 1.441617 0.349935 0.914808 0.980557 0.726319 1.198985 0.399326 0.474276 0.300012 0.526007 1.397913 0.571732 0.755943 0.214448 0.154311 1.592620 1.249192 -0.077443 1.368706 0.509250 1.318476 0.945961 1.468387 0.183695 0.664527 1.300061 -0.027000 1.001379 0.929128 1.304185 0.831474 0.706756 1.512898 1.454699 1.717780 0.651184 0.642835 -0.499734 0.630599 0.974237 1.053814 0.080361 1.234814 0.970289 -0.493629 1.743021 1.595909 0.546977 0.187754 1.146398 0.295146 -0.024573 0.876472 0.743508 0.001543 0.176972 0.368727 1.701826 1.700262 0.500448 1.251611 0.327263 0.327670 0.054495 1.194839 0.257936 1.139524 1.485204 0.544880 0.953454 0.933603 0.684026 0.559766 1.754764 0.973882 -0.200106 0.249724 0.369814 0.520681 1.725523 1.001321 0.330922 0.896911 1.423434 -0.323745 1.014303 0.360348 0.157833 0.998375 0.462005 0.093675 0.028466) + 14.004691 #r(0.000000 -0.073458 1.805356 -0.019690 0.416815 1.741541 1.833092 -0.834497 0.391327 0.465981 1.139518 0.042960 1.548539 0.281806 0.145851 0.342223 0.280626 0.106734 1.239210 -0.158204 0.647603 1.369485 1.110190 0.967392 0.302807 0.600491 0.004336 -0.283408 -0.381933 -0.098815 1.100237 1.444433 0.391479 0.940546 1.005390 0.792561 1.176733 0.424577 0.435983 0.273865 0.514364 1.389652 0.545934 0.739336 0.179715 0.135731 1.549282 1.302303 -0.041515 1.397841 0.552470 1.332897 0.969893 1.460618 0.182887 0.701431 1.339041 0.008093 0.983031 0.858735 1.289095 0.863475 0.706938 1.503324 1.447503 1.696714 0.666052 0.662299 -0.511440 0.661051 1.015885 1.047294 0.074499 1.261412 0.935338 -0.509907 1.759237 1.624352 0.511850 0.202451 1.138406 0.329662 -0.007086 0.859983 0.790799 -0.009133 0.184207 0.395429 1.699370 1.727317 0.602797 1.237173 0.304485 0.299370 0.070414 1.129779 0.317264 1.099123 1.499140 0.546005 0.956303 0.947635 0.721164 0.531155 1.762166 1.009658 -0.199931 0.274997 0.367127 0.530047 1.718825 0.999546 0.398688 0.869574 1.439233 -0.353688 1.067056 0.389772 0.215464 0.967595 0.454912 0.170567 0.042937) ) ;;; 124 prime -------------------------------------------------------------------------------- (vector 124 17.868420183527 #r(0 0 0 1 0 0 1 1 0 1 0 1 0 0 0 0 0 1 1 1 1 1 1 0 1 0 0 1 1 1 0 1 1 0 1 1 1 0 0 1 0 1 1 1 0 1 1 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 1 1 0 1 1 1 0 1 1 0 1 0 1 0 0 0 0 0 0 0 0 0 1 1 0 0 1 1 0 0 0 1 1 0 0 0 1 0 0 0 0 1 1 1 1 0 1 0 0 0 1 0 0 1 1 0 0 1) 14.279834 #r(0.000000 -0.081380 1.782165 -0.062634 0.363611 1.777729 1.870086 -0.748456 0.397000 0.457689 1.108119 0.004930 1.540452 0.247288 0.180358 0.333199 0.182296 0.178249 1.230554 -0.108533 0.646062 1.305622 0.825072 0.858877 0.381906 0.623442 1.836712 -0.249134 -0.191182 -0.125952 1.112553 1.374523 0.342721 0.833331 0.944734 0.720943 1.282090 0.390216 0.453997 0.358637 0.493600 1.372859 0.624272 0.735874 0.299299 0.184937 1.617155 1.281616 -0.070863 1.469387 0.307926 1.334541 0.930607 1.487203 0.131059 0.597353 1.290211 -0.242352 1.036453 0.942866 1.246650 0.636276 0.826032 1.531105 1.485955 1.813085 0.625741 0.627771 -0.579465 0.642188 0.969289 1.138476 0.074565 1.189823 0.939892 -0.416570 1.739435 1.565378 0.588268 0.099664 1.234765 0.379725 -0.063217 0.934469 0.845969 1.930710 0.181988 0.295750 1.696778 1.677311 0.505493 1.249700 0.433102 0.439581 0.020795 1.231023 0.285770 1.217649 1.421529 0.551828 0.924619 0.972048 0.789871 0.556108 1.717849 1.016229 -0.325643 0.376556 0.293594 0.487260 1.648794 1.072609 0.281420 0.961161 1.519437 -0.241812 1.031705 0.425825 0.197195 1.096632 0.361878 0.106170 -0.074233 0.005979) - 14.251895 #r(0.000000 -0.081027 1.759507 -0.057285 0.359356 1.767493 1.868621 -0.754585 0.369946 0.433648 1.115964 -0.028991 1.546830 0.247641 0.209367 0.339084 0.178466 0.156550 1.216284 -0.129741 0.628469 1.277027 0.811970 0.881714 0.396187 0.653302 1.850835 -0.273491 -0.185053 -0.137579 1.117160 1.405321 0.351879 0.859016 0.946182 0.752104 1.320592 0.414306 0.410653 0.344042 0.497825 1.388178 0.632752 0.734710 0.301604 0.187996 1.607759 1.287726 -0.082233 1.477545 0.319744 1.334990 0.920349 1.478942 0.229849 0.592000 1.259139 -0.214564 1.058301 0.953933 1.248996 0.648377 0.854558 1.534664 1.508200 1.810964 0.611355 0.618766 -0.587645 0.633996 1.004985 1.123972 0.113665 1.174277 0.905565 -0.466167 1.736456 1.593517 0.587206 0.135447 1.232503 0.419352 -0.057073 0.909433 0.881439 1.928097 0.185692 0.294114 1.668815 1.696651 0.473507 1.286266 0.415248 0.430359 0.034903 1.190715 0.313669 1.201133 1.481713 0.566991 0.919822 0.975087 0.829210 0.579090 1.771518 0.995299 -0.302045 0.445927 0.319026 0.478808 1.631192 1.065591 0.264307 0.976144 1.488999 -0.277660 1.044189 0.407926 0.191416 1.090124 0.365315 0.135641 -0.043832 0.015538) + 14.224599 #r(0.000000 -0.074080 1.733005 -0.070181 0.348340 1.773153 1.855621 -0.718765 0.358763 0.420976 1.104513 -0.016522 1.591889 0.268182 0.211181 0.336610 0.161402 0.138374 1.186479 -0.166295 0.613913 1.305339 0.783112 0.870830 0.415906 0.645429 1.863689 -0.308545 -0.151083 -0.118469 1.108438 1.403137 0.347324 0.878717 0.950219 0.761552 1.280816 0.446291 0.391634 0.309216 0.513038 1.445846 0.612845 0.761353 0.281584 0.209059 1.634279 1.245751 -0.144420 1.451638 0.329122 1.360903 0.909334 1.468255 0.228471 0.570531 1.237414 -0.230560 1.053073 0.969057 1.254004 0.664066 0.872940 1.505873 1.551215 1.831147 0.598172 0.607592 -0.593337 0.666710 1.032793 1.129397 0.093313 1.184854 0.857034 -0.485336 1.758226 1.615159 0.592882 0.140022 1.195170 0.455593 -0.053449 0.868872 0.906853 1.959027 0.178368 0.295811 1.655854 1.696458 0.440368 1.307637 0.380512 0.406497 0.039551 1.183218 0.346608 1.214681 1.509993 0.508571 0.926190 0.952812 0.798904 0.543131 1.777134 0.957822 -0.309992 0.460864 0.291319 0.422414 1.633589 1.095863 0.196768 0.907113 1.488138 -0.254762 1.052585 0.412071 0.161966 1.091013 0.361251 0.114976 -0.088256 0.029985) ) ;;; 125 prime -------------------------------------------------------------------------------- (vector 125 17.637776156888 #r(0 1 1 0 1 0 0 1 0 1 0 0 1 1 0 0 0 1 0 0 1 1 0 0 1 1 1 1 0 1 1 0 0 0 0 1 1 0 0 0 1 1 1 1 0 0 0 0 1 0 1 0 1 0 0 0 1 0 0 0 1 1 0 0 0 1 0 0 1 1 1 0 1 0 0 0 0 1 0 0 0 0 1 1 1 1 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 1 1 1 1 0 0 1 1 1 1 1 1 1 1 1 0 1 1 1) 14.335616 #r(0.000000 -0.073704 1.756721 -0.027521 0.555274 1.787030 1.851198 -0.739687 0.444117 0.371512 1.030097 0.041170 1.545538 0.189519 0.163161 0.279241 0.173564 0.127795 1.239047 -0.127708 0.674274 1.329026 0.927305 0.921971 0.291034 0.575583 1.919448 -0.265928 -0.189299 -0.242314 1.071327 1.320148 0.401414 0.885029 1.046562 0.775451 1.215839 0.374013 0.421290 0.242139 0.417910 1.413086 0.643233 0.744664 0.179383 0.219870 1.572661 1.345306 -0.060756 1.371806 0.318705 1.344767 0.903717 1.446972 0.029587 0.642047 1.254548 -0.199918 1.025990 0.987502 1.268140 0.763438 0.716412 1.540475 1.448750 1.854247 0.619685 0.691226 -0.557884 0.607847 0.974173 1.151524 -0.000158 1.208581 0.923167 -0.344361 1.808080 1.613014 0.625897 0.097908 1.229154 0.352252 -0.000924 0.978476 0.892610 1.915124 0.237884 0.295218 1.727938 1.672743 0.433468 1.238004 0.487776 0.417610 0.023342 1.153124 0.251246 1.196960 1.459291 0.552975 0.974914 0.953186 0.742186 0.557329 1.742338 1.006012 -0.331621 0.294231 0.321006 0.465332 1.742325 1.134043 0.251983 0.900167 1.477710 -0.206427 1.075443 0.425293 0.211597 1.112385 0.321994 0.162492 -0.098661 0.047474 0.072546) - 14.211701 #r(0.000000 -0.064069 1.779783 -0.020093 0.522033 1.795462 1.813843 -0.783548 0.464871 0.354758 1.084871 0.040027 1.522370 0.144506 0.175280 0.258277 0.125081 0.098648 1.252877 -0.188689 0.654937 1.355110 0.930083 0.926070 0.281257 0.571670 1.958164 -0.267730 -0.219188 -0.294681 1.055783 1.427962 0.370290 0.877538 1.027915 0.800679 1.198779 0.402704 0.372782 0.228544 0.424879 1.459145 0.646391 0.690065 0.096229 0.183821 1.523627 1.375917 -0.116300 1.415408 0.359249 1.347008 0.887890 1.504991 0.124802 0.621792 1.229764 -0.196779 1.026166 0.981743 1.267442 0.843987 0.684789 1.561503 1.495359 1.842047 0.620448 0.626599 -0.555464 0.636197 1.098050 1.180262 0.047210 1.188325 0.861442 -0.401180 1.856988 1.636029 0.600127 0.119548 1.185097 0.386489 0.050347 0.914672 0.967743 1.935056 0.212376 0.335644 1.725490 1.680537 0.417404 1.241386 0.442853 0.312942 -0.025410 1.079399 0.293634 1.134513 1.513850 0.564254 0.921827 0.927338 0.755504 0.612470 1.782516 1.034148 -0.326433 0.424498 0.310751 0.446536 1.731105 1.110088 0.175158 0.877763 1.474537 -0.222155 1.089050 0.422908 0.204858 1.068692 0.283593 0.198780 -0.096766 0.096108 0.189126) + 14.158986 #r(0.000000 -0.040892 1.765109 -0.022000 0.503492 1.759632 1.819076 -0.737762 0.467518 0.322934 1.051333 0.042978 1.519116 0.110374 0.134285 0.249774 0.112920 0.091605 1.303077 -0.190483 0.655975 1.382013 0.942064 0.892652 0.257205 0.577951 -0.003716 -0.309994 -0.244845 -0.377881 1.085310 1.453178 0.413210 0.851018 1.025342 0.845612 1.186797 0.429224 0.393474 0.256366 0.419534 1.484171 0.612022 0.713243 0.053587 0.215115 1.515636 1.368067 -0.088883 1.423575 0.354269 1.325445 0.891931 1.479260 0.151898 0.610391 1.219481 -0.156953 0.981058 0.987425 1.248292 0.869440 0.669257 1.540299 1.499600 1.859428 0.627634 0.613653 -0.581252 0.692857 1.130918 1.172266 0.057915 1.217060 0.831623 -0.415209 1.851340 1.601722 0.621631 0.087909 1.170963 0.434414 0.048113 0.935100 0.985740 1.917178 0.257433 0.374700 1.735726 1.681748 0.426213 1.241046 0.436133 0.296260 -0.045740 1.063218 0.286359 1.131941 1.450487 0.554613 0.891126 0.951014 0.776061 0.671510 1.751753 1.066050 -0.264299 0.440635 0.258529 0.424068 1.705114 1.111515 0.167470 0.881027 1.448398 -0.209314 1.088143 0.427063 0.217960 1.061579 0.278952 0.272334 -0.123783 0.075631 0.209955) ) ;;; 126 prime -------------------------------------------------------------------------------- (vector 126 18.284595039843 #r(0 0 0 0 1 1 1 1 0 1 0 1 0 1 0 1 1 1 1 1 1 1 1 1 1 1 1 0 1 0 1 0 1 0 0 0 0 0 0 0 0 1 1 0 0 1 1 1 1 1 0 1 1 0 0 1 0 0 0 1 0 1 1 1 1 1 0 0 1 1 0 1 0 1 1 1 1 1 1 0 0 1 0 1 0 0 0 0 1 1 0 1 1 0 0 1 0 0 1 1 0 0 1 0 1 1 0 0 1 1 1 1 0 0 0 1 1 0 0 1 0 1 1 1 0 1) 14.478183 #r(0.000000 0.930861 1.435103 1.015217 0.133148 0.287358 1.954448 0.877191 -0.313979 0.188033 1.404924 0.797822 1.641089 -0.072460 0.883498 1.253629 0.955039 1.649989 1.112182 0.909200 1.887346 0.566087 0.831325 1.595619 1.015259 1.132981 1.214225 1.758075 1.475152 1.620993 0.072446 -0.059078 -0.182289 -0.039338 0.155445 0.529297 0.046388 1.441668 0.535178 0.222607 0.659275 1.874433 0.311495 1.718719 0.434358 1.778879 1.619012 0.517997 0.354459 -0.261087 0.248995 1.922764 0.605114 1.052457 -0.265751 1.118974 0.375392 1.608325 1.902594 0.729575 1.283255 1.305350 0.868120 1.355763 1.680987 0.242830 0.477218 1.016250 0.628871 -0.030446 0.679211 1.826138 1.874720 1.129680 1.690954 1.195384 0.889438 1.205646 1.461460 -0.453690 0.712708 1.258870 1.879622 1.875344 1.343716 1.283838 0.647289 0.933542 0.025722 -0.304513 0.859639 0.850257 0.333502 1.942927 1.798084 1.335700 0.932797 0.281618 -0.061736 1.117606 1.074494 0.424155 0.429073 1.579564 1.707609 0.889204 0.016152 1.499631 0.327239 1.110073 0.816898 0.676932 0.517090 0.873228 0.943685 1.557236 1.328668 0.393069 1.595818 0.801812 0.427544 0.632088 1.930520 1.052145 0.001869 0.373834) - 14.264875 #r(0.000000 1.024949 1.417347 1.041818 0.163100 0.212231 1.948098 0.896535 -0.263940 0.176175 1.393064 0.753467 1.601274 -0.092388 0.889275 1.186362 0.985086 1.677584 1.130148 0.938011 1.933752 0.676162 0.797090 1.644359 0.889626 1.105485 1.113792 1.790075 1.482480 1.589550 0.092151 -0.017363 -0.089279 -0.115141 0.176226 0.605514 0.038994 1.454438 0.565589 0.268026 0.654634 1.963110 0.228905 1.717153 0.470254 1.778156 1.640641 0.427169 0.306670 -0.337778 0.238095 1.968623 0.663582 1.099708 -0.251326 1.148918 0.326458 1.643281 1.978469 0.738171 1.260297 1.352038 0.897776 1.399563 1.681255 0.188546 0.525025 0.915069 0.616772 -0.130185 0.743998 1.875366 1.938059 1.147563 1.661142 1.171294 0.835403 1.249055 1.475976 -0.464312 0.755426 1.298558 1.859186 1.828937 1.397028 1.315070 0.648741 1.026017 -0.003428 -0.346654 0.841071 0.949301 0.342089 1.873661 1.830681 1.341306 0.882005 0.275442 -0.041623 1.073170 1.090339 0.384813 0.335534 1.574043 1.691632 0.883558 0.023907 1.566644 0.343917 1.195169 0.823067 0.724732 0.531129 0.878425 0.982492 1.497674 1.383368 0.360306 1.549300 0.896127 0.336273 0.594673 0.031619 1.040580 -0.067634 0.362694) + 14.166527 #r(0.000000 0.951214 1.422014 1.065913 0.138207 0.148477 1.910207 0.990269 -0.276029 0.161947 1.396699 0.690380 1.558607 -0.167542 0.929335 1.073027 0.979326 1.723440 1.140136 0.942022 1.965154 0.706421 0.783545 1.673233 0.830131 1.112066 0.979503 1.855859 1.492030 1.609588 -0.032965 0.022678 -0.045310 -0.209466 0.191647 0.622400 0.055736 1.469548 0.532570 0.280502 0.632469 1.977133 0.260571 1.780914 0.477078 1.750348 1.693019 0.375365 0.346969 -0.389517 0.189297 -0.000636 0.668997 1.085612 -0.221629 1.237889 0.292787 1.706220 0.015742 0.719367 1.248338 1.377974 0.894143 1.416905 1.714536 0.204690 0.520779 0.939454 0.635736 -0.143454 0.760398 1.961536 0.008932 1.167899 1.623771 1.168853 0.891519 1.267417 1.473074 -0.467317 0.786222 1.300669 1.788642 1.914860 1.384817 1.311676 0.639041 0.993927 0.056846 -0.430395 0.869429 0.998574 0.336235 1.890844 1.844157 1.324416 0.823958 0.264618 -0.097699 1.004739 1.037500 0.346111 0.267617 1.620449 1.718848 0.930344 -0.030077 1.538495 0.403445 1.237507 0.924957 0.808428 0.528516 0.822159 0.946861 1.447848 1.482730 0.354819 1.484641 0.995056 0.303167 0.579653 0.008449 0.979894 -0.079477 0.282640) ) ;;; 127 prime -------------------------------------------------------------------------------- (vector 127 18.198689419357 #r(0 0 0 1 0 0 1 0 1 0 0 0 1 0 1 1 1 0 0 1 0 1 1 0 1 0 1 0 0 0 0 1 0 1 1 0 1 1 1 1 0 1 0 0 1 1 1 0 0 1 1 0 1 1 1 1 0 1 1 0 1 0 1 1 1 1 0 1 0 0 0 0 1 1 0 1 1 0 0 0 0 0 0 1 1 0 0 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 0 1 1 0 1 0 0 0 0 1 1 0 1 0 1 1 0 0 0 1 1 1 1 1) 14.536393 #r(0.000000 0.910972 1.475131 1.009861 0.062727 0.222323 1.938743 0.836711 -0.379271 0.255108 1.367947 0.841274 1.648864 0.015930 0.884691 1.125991 0.989606 1.607929 1.107388 0.857011 1.831346 0.433218 0.833149 1.592445 1.050762 1.008151 1.363530 1.700977 1.491038 1.682961 0.086100 -0.103806 -0.179348 0.003896 0.165438 0.493687 0.089620 1.387284 0.581547 0.176309 0.705269 1.811651 0.301490 1.707605 0.333845 1.832817 1.652148 0.600871 0.309714 -0.231587 0.303261 1.879368 0.673797 1.138199 -0.287759 1.071255 0.390644 1.597999 1.895638 0.729896 1.280128 1.313792 0.920129 1.387655 1.675038 0.226144 0.498585 1.104083 0.607578 0.005976 0.644124 1.859066 1.816208 1.159654 1.721231 1.377183 0.892151 1.087634 1.544878 -0.427006 0.761009 1.308993 1.890672 1.804683 1.325584 1.333615 0.649826 0.878906 0.043600 -0.222822 0.983855 0.725901 0.429955 1.892651 1.820617 1.395993 0.939478 0.246907 -0.065788 1.167118 1.004041 0.432075 0.450312 1.618752 1.686873 0.868341 1.893872 1.401676 0.376204 1.113598 0.748962 0.732995 0.557016 0.919800 0.871855 1.529811 1.275389 0.387399 1.586418 0.758929 0.456983 0.576267 1.810711 1.106484 0.012213 0.311973 1.081248) - 14.292624 #r(0.000000 0.926093 1.458952 1.063976 0.127975 0.219906 1.954030 0.816219 -0.427531 0.210893 1.429880 0.845592 1.634732 0.061406 0.886285 1.181360 0.975164 1.630940 1.133009 0.936978 1.867159 0.531555 0.732550 1.638015 0.976031 1.075325 1.288278 1.672215 1.485221 1.690646 0.067322 -0.137085 -0.149107 0.017136 0.167544 0.501605 0.068822 1.362143 0.565007 0.244812 0.652777 1.824984 0.280473 1.721945 0.339817 1.867690 1.574974 0.564702 0.342184 -0.272706 0.303499 1.867796 0.607813 1.138356 -0.249726 1.044434 0.418758 1.592305 1.942855 0.764856 1.319946 1.323402 0.871598 1.404768 1.689729 0.233270 0.470826 0.983145 0.556040 -0.092682 0.657641 1.876266 1.916969 1.207783 1.683541 1.304118 0.830947 1.163767 1.578711 -0.482050 0.716676 1.384632 1.944806 1.787812 1.377124 1.355016 0.636807 1.002304 0.077047 -0.258218 1.006079 0.828796 0.448792 1.838488 1.777859 1.361994 0.856643 0.290660 0.047515 1.110880 1.077621 0.328888 0.423573 1.585660 1.581092 0.816065 -0.012259 1.449551 0.301870 1.098459 0.839564 0.751953 0.493558 0.934038 1.016671 1.573258 1.224410 0.343130 1.509240 0.821961 0.511574 0.603989 1.945220 1.130701 0.029123 0.344588 1.131060) + 14.174489 #r(0.000000 0.918374 1.401493 1.079177 0.097566 0.200300 1.925192 0.860915 -0.394662 0.197171 1.375391 0.789043 1.600818 0.060078 0.915448 1.221886 1.001495 1.630517 1.131926 0.987291 1.892115 0.613914 0.729204 1.662077 0.937961 1.152506 1.173910 1.689664 1.511287 1.756044 0.002212 -0.107545 -0.144649 -0.012298 0.257949 0.545120 0.073075 1.363629 0.598464 0.236386 0.623074 1.859155 0.251153 1.716261 0.356134 1.826451 1.560307 0.519568 0.324006 -0.319804 0.317231 1.809952 0.592644 1.107529 -0.232911 1.106945 0.285068 1.713121 0.024663 0.846067 1.302515 1.302251 0.870368 1.500995 1.632297 0.194634 0.459785 0.953715 0.545313 -0.125627 0.748842 1.929590 1.917504 1.229948 1.714108 1.246351 0.736410 1.171986 1.591842 -0.489186 0.738659 1.446787 1.902484 1.777216 1.489734 1.429364 0.677974 1.055542 0.101214 -0.333472 0.976667 0.851937 0.378122 1.836862 1.739303 1.354537 0.826887 0.272496 0.078367 1.090532 1.085254 0.297519 0.403506 1.637908 1.602312 0.877747 0.025888 1.446129 0.289960 1.156805 0.906508 0.716863 0.489399 0.884874 1.068984 1.479757 1.258618 0.387674 1.533901 0.832257 0.518681 0.657430 0.036094 1.128930 0.058674 0.254854 1.186142) ) ;;; 128 prime -------------------------------------------------------------------------------- (vector 128 18.276384353638 #r(0 0 1 0 1 0 0 0 0 1 0 0 0 1 1 0 1 1 1 1 0 1 1 1 0 0 0 0 0 1 0 0 1 1 0 1 1 0 0 0 0 0 1 0 1 0 1 0 1 1 0 1 0 0 0 0 1 1 0 1 1 1 0 1 1 1 0 1 1 0 1 1 1 0 1 1 0 0 1 1 0 0 1 1 0 1 0 0 1 1 0 0 1 0 0 1 0 1 1 1 1 0 1 1 1 0 0 1 0 0 0 0 1 1 1 1 1 1 0 1 0 1 1 0 1 0 0 1) 14.551285 #r(0.000000 0.924459 1.485422 0.985256 0.056811 0.219930 1.908499 0.913743 -0.403193 0.259904 1.334649 0.827148 1.624714 -0.021872 0.937257 1.122813 0.961899 1.532146 1.148701 0.868319 1.827482 0.356035 0.897995 1.553711 0.943178 0.960525 1.352917 1.720117 1.523327 1.617955 0.013172 -0.149597 -0.137644 -0.034035 0.111097 0.498787 0.121406 1.399436 0.620595 0.082527 0.702328 1.824635 0.362315 1.752651 0.335052 1.794344 1.642190 0.610334 0.262361 -0.222978 0.248243 1.869656 0.644580 1.192948 -0.312319 1.070271 0.368940 1.593867 1.836900 0.676177 1.276819 1.276408 0.936758 1.361721 1.692175 0.215294 0.511916 1.079847 0.588820 0.055407 0.579633 1.891289 1.810098 1.133091 1.733591 1.452365 0.980479 1.078929 1.556717 -0.427469 0.779143 1.336023 1.912299 1.782248 1.339461 1.329616 0.616924 0.917615 0.006788 -0.195359 0.981816 0.758001 0.419952 1.868089 1.758394 1.479010 0.921655 0.244745 -0.038674 1.158515 0.987245 0.469852 0.442126 1.652528 1.699770 0.900506 1.793377 1.368738 0.405805 1.083967 0.706228 0.759055 0.550546 0.985536 0.835398 1.537041 1.252754 0.414912 1.587016 0.741668 0.441787 0.537126 1.829954 1.207186 -0.038603 0.324826 1.093300 0.845470) - 14.405346 #r(0.000000 0.924026 1.499764 0.994686 0.081230 0.279218 1.934443 0.928192 -0.395918 0.234838 1.382042 0.876533 1.673561 -0.028059 0.840149 1.204491 0.977738 1.554540 1.179875 0.861328 1.819414 0.358875 0.881836 1.556567 0.863726 1.037056 1.233163 1.710500 1.516140 1.649745 0.087279 -0.125291 -0.255591 -0.002873 0.097876 0.475223 0.070253 1.421649 0.607944 0.061379 0.713412 1.808612 0.351031 1.731090 0.368893 1.791635 1.613915 0.608101 0.288431 -0.252467 0.210724 1.877955 0.635301 1.253982 -0.301731 1.079863 0.416220 1.601349 1.836569 0.696333 1.292165 1.283369 0.941126 1.337726 1.684259 0.167609 0.536318 1.073821 0.603018 0.041922 0.592621 1.905107 1.849021 1.173514 1.720057 1.469679 0.880252 1.073289 1.621020 -0.537136 0.707885 1.353256 1.932909 1.789300 1.361545 1.334340 0.635162 0.966311 -0.007792 -0.178114 1.053112 0.781568 0.400907 1.785080 1.891613 1.475279 0.852137 0.250548 -0.004683 1.138728 1.006979 0.466545 0.449928 1.612191 1.625614 0.787200 1.817428 1.376874 0.400816 1.039183 0.646074 0.742455 0.557256 0.904101 0.927009 1.466191 1.282414 0.394652 1.574954 0.707704 0.470249 0.516148 1.908451 1.234222 -0.057603 0.321077 1.094696 0.844091) + 14.321985 #r(0.000000 0.912824 1.492985 1.087261 0.111187 0.236866 1.918622 0.948674 -0.353555 0.254975 1.357675 0.933178 1.623908 0.015107 0.794912 1.244431 0.983251 1.479874 1.179334 0.911508 1.834687 0.377630 0.866945 1.571139 0.892097 1.054515 1.137810 1.774457 1.581539 1.640513 0.063968 -0.124745 -0.309607 -0.003226 0.121283 0.504011 0.088400 1.419316 0.595850 0.073745 0.708976 1.805303 0.308812 1.715027 0.360073 1.773676 1.576930 0.625674 0.239413 -0.276953 0.233627 1.838601 0.681352 1.215516 -0.286723 1.087230 0.416455 1.670250 1.850249 0.764006 1.237852 1.336091 0.881603 1.374130 1.712624 0.202154 0.526766 1.027803 0.618686 -0.004718 0.639698 1.925686 1.888362 1.242580 1.697632 1.419016 0.839105 1.094136 1.613004 -0.570474 0.732712 1.366617 1.946110 1.786471 1.393771 1.313191 0.611556 0.933233 0.027940 -0.211642 0.998626 0.798684 0.386755 1.743273 1.912495 1.501396 0.822580 0.269047 0.000950 1.156711 0.968985 0.495508 0.444854 1.623423 1.652590 0.773155 1.724103 1.325379 0.439659 1.052950 0.679687 0.687540 0.602405 0.857211 1.013033 1.445967 1.264913 0.419776 1.570485 0.685766 0.461934 0.538599 1.970400 1.181634 -0.017962 0.299180 1.089782 0.805786) ) ;;; 256 prime -------------------------------------------------------------------------------- @@ -4635,53 +4628,34 @@ ;; 1 Dec 4161.032, sqrts: 122 122 0 0 (0.0000) ;; (15) ;; 1 Jan 4158.938 -;; 1 Feb 4156.526 -;; 1 Mar 4154.769 -;; 1 Apr 4154.180 -;; 1 May 4153.716 -;; 1 Jun 4153.330 -;; 1 Jul 4152.859 -;; 1 Aug 4152.637 -;; 1 Sep 4152.306 -;; 1 Oct 4152.200 -;; 1 Nov 4152.089 -;; 1 Dec 4151.958 ;; (16) ;; 1 Jan 4151.620 ;; (17) ;; 1-Oct 4150.037 ;; (18) ;; 1-Jan 4149.99 +;; (19) +;; 1-Jan 4139.71 ; all 0.4860 (20) to 0.4986 (125), dist: 0.0000, 15.0910 ; odd 0.4820 (11) to 0.5000 (112), dist: 0.0000, 9.0892 -; even 0.5085 (115) to 0.5242 (22), dist: 57.6613, 0.0000 -; prime 0.5444 (24) to 0.5540 (67), dist: 232.5920, 0.0000 +; even 0.5067 (120) to 0.5242 (22), dist: 55.3350, 0.0000 +; prime 0.5444 (24) to 0.5539 (67), dist: 224.6387, 0.0000 #| -11-Sep-18: -sum: 4144.997061384121, sqrts: 122 122 0 0 (0.0000) - all 0.4860 (20) to 0.4986 (125), dist: 0.0000, 15.0910 - odd 0.4820 (11) to 0.5000 (112), dist: 0.0000, 9.0892 - even 0.5067 (120) to 0.5242 (22), dist: 55.3350, 0.0000 - prime 0.5444 (24) to 0.5539 (67), dist: 229.9206, 0.0000 - -13-Nov-18: -sum: 4141.875673384123, sqrts: 122 122 0 0 (0.0000) - prime 0.5444 (24) to 0.5539 (67), dist: 226.7992, 0.0000 - -<1> (load "test-phases.scm") -;all peaks... Sun 21-Oct-2018 03:20 -(0.001485373829890335 119) -;odd peaks... Sun 21-Oct-2018 03:22 -(0.001687315629055774 125) -;even peaks... Sun 21-Oct-2018 03:23 +20-Dec-18: +;all peaks... Thu 20-Dec-2018 07:25 +(0.001485373829899217 119) +;odd peaks... Thu 20-Dec-2018 07:27 +(0.001687315629052222 125) +;even peaks... Thu 20-Dec-2018 07:28 (0.001467169674692848 4) -;prime peaks... Sun 21-Oct-2018 03:24 +;prime peaks... Thu 20-Dec-2018 07:30 (0.001975582609148319 2048) -;all done! Sun 21-Oct-2018 03:26 +;all done! Thu 20-Dec-2018 07:32 ;(test-all-phases #f) in test-phases.scm +;repl test-phases.scm ;;; 31-May-10: 214 ;;; 1-Mar-11: 120 Binary files 19-1/pix/newbuttons.png and 19.0-1/pix/newbuttons.png differ diff -pruN 19-1/s7.c 19.0-1/s7.c --- 19-1/s7.c 2018-11-23 11:33:47.000000000 +0000 +++ 19.0-1/s7.c 2019-01-01 12:51:43.000000000 +0000 @@ -434,7 +434,7 @@ typedef intptr_t opcode_t; typedef long double long_double; #define print_s7_int PRId64 -#define print_int32 PRId32 +/* #define print_int32 PRId32 */ #define print_pointer PRIdPTR #define MAX_FLOAT_FORMAT_PRECISION 128 @@ -632,7 +632,7 @@ typedef struct { typedef struct { s7_int type, outer_type; - s7_pointer scheme_name; + s7_pointer scheme_name, getter, setter; void (*free)(void *value); void (*mark)(void *val); bool (*equal)(void *val1, void *val2); /* can this be wrapped? */ @@ -658,6 +658,7 @@ static hash_map_t default_hash_map[NUM_T /* -------------------------------- */ typedef s7_int (*s7_i_7pi_t)(s7_scheme *sc, s7_pointer p, s7_int i1); typedef s7_int (*s7_i_7pii_t)(s7_scheme *sc, s7_pointer p, s7_int i1, s7_int i2); +typedef s7_int (*s7_i_7piii_t)(s7_scheme *sc, s7_pointer p, s7_int i1, s7_int i2, s7_int i3); typedef s7_int (*s7_i_iii_t)(s7_int i1, s7_int i2, s7_int i3); typedef s7_int (*s7_i_7i_t)(s7_scheme *sc, s7_int i1); typedef s7_int (*s7_i_7ii_t)(s7_scheme *sc, s7_int i1, s7_int i2); @@ -675,12 +676,18 @@ typedef s7_pointer (*s7_p_pp_t)(s7_schem typedef s7_pointer (*s7_p_ppi_t)(s7_scheme *sc, s7_pointer p1, s7_pointer p2, s7_int i1); typedef s7_pointer (*s7_p_ppp_t)(s7_scheme *sc, s7_pointer p1, s7_pointer p2, s7_pointer p3); typedef s7_pointer (*s7_p_pi_t)(s7_scheme *sc, s7_pointer p1, s7_int i1); +typedef s7_pointer (*s7_p_pii_t)(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_int i2); typedef s7_pointer (*s7_p_pip_t)(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_pointer p2); +typedef s7_pointer (*s7_p_piip_t)(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_int i2, s7_pointer p3); +typedef s7_pointer (*s7_p_i_t)(s7_scheme *sc, s7_int i); typedef s7_pointer (*s7_p_ii_t)(s7_scheme *sc, s7_int i1, s7_int i2); +typedef s7_pointer (*s7_p_d_t)(s7_scheme *sc, s7_double x); typedef s7_pointer (*s7_p_dd_t)(s7_scheme *sc, s7_double x1, s7_double x2); typedef s7_double (*s7_d_7d_t)(s7_scheme *sc, s7_double p1); typedef s7_double (*s7_d_7dd_t)(s7_scheme *sc, s7_double p1, s7_double p2); typedef s7_double (*s7_d_7p_t)(s7_scheme *sc, s7_pointer p1); +typedef s7_double (*s7_d_7pii_t)(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_int i2); +typedef s7_double (*s7_d_7piid_t)(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_int i2, s7_double x1); typedef union { s7_int i; @@ -701,6 +708,8 @@ typedef union { s7_double (*d_vid_f)(void *obj, s7_int i, s7_double fm); s7_double (*d_id_f)(s7_int i, s7_double fm); s7_double (*d_7pi_f)(s7_scheme *sc, s7_pointer obj, s7_int i1); + s7_double (*d_7pii_f)(s7_scheme *sc, s7_pointer obj, s7_int i1, s7_int i2); + s7_double (*d_7piid_f)(s7_scheme *sc, s7_pointer obj, s7_int i1, s7_int i2, s7_double x); s7_double (*d_ip_f)(s7_int i1, s7_pointer p); s7_double (*d_pd_f)(s7_pointer obj, s7_double x); s7_double (*d_7pid_f)(s7_scheme *sc, s7_pointer obj, s7_int i1, s7_double x); @@ -715,6 +724,7 @@ typedef union { s7_int (*i_iii_f)(s7_int i1, s7_int i2, s7_int i3); s7_int (*i_7pi_f)(s7_scheme *sc, s7_pointer p, s7_int i1); s7_int (*i_7pii_f)(s7_scheme *sc, s7_pointer p, s7_int i1, s7_int i2); + s7_int (*i_7piii_f)(s7_scheme *sc, s7_pointer p, s7_int i1, s7_int i2, s7_int i3); bool (*b_i_f)(s7_int p); bool (*b_d_f)(s7_double p); bool (*b_p_f)(s7_pointer p); @@ -729,9 +739,13 @@ typedef union { s7_pointer (*p_pp_f)(s7_scheme *sc, s7_pointer p1, s7_pointer p2); s7_pointer (*p_ppp_f)(s7_scheme *sc, s7_pointer p, s7_pointer p2, s7_pointer p3); s7_pointer (*p_pi_f)(s7_scheme *sc, s7_pointer p1, s7_int i1); + s7_pointer (*p_pii_f)(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_int i2); s7_pointer (*p_ppi_f)(s7_scheme *sc, s7_pointer p1, s7_pointer p2, s7_int i1); s7_pointer (*p_pip_f)(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_pointer p2); + s7_pointer (*p_piip_f)(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_int i2, s7_pointer p3); + s7_pointer (*p_i_f)(s7_scheme *sc, s7_int i); s7_pointer (*p_ii_f)(s7_scheme *sc, s7_int x1, s7_int x2); + s7_pointer (*p_d_f)(s7_scheme *sc, s7_double x); s7_pointer (*p_dd_f)(s7_scheme *sc, s7_double x1, s7_double x2); s7_double (*fd)(void *o); s7_int (*fi)(void *o); @@ -999,9 +1013,9 @@ typedef struct s7_cell { int32_t file_and_line; #endif #if S7_DEBUGGING - int32_t current_alloc_line, previous_alloc_line, uses, explicit_free_line; + int32_t current_alloc_line, previous_alloc_line, uses, explicit_free_line, opt1_line, opt2_line, opt3_line; int64_t current_alloc_type, previous_alloc_type, debugger_bits; - const char *current_alloc_func, *previous_alloc_func; + const char *current_alloc_func, *previous_alloc_func, *opt1_func, *opt2_func, *opt3_func; #endif } s7_cell; @@ -1019,7 +1033,6 @@ typedef struct heap_block_t { struct heap_block_t *next; } heap_block_t; - typedef struct { s7_pointer *objs; int32_t size, top, ref, size2; @@ -1068,10 +1081,9 @@ struct s7_scheme { int64_t heap_size, gc_freed, max_heap_size; #if WITH_HISTORY - s7_pointer eval_history1, eval_history2, error_history; + s7_pointer eval_history1, eval_history2, error_history, history_sink, history_pairs; bool using_history1; #endif - bool history_enabled; #if WITH_MULTITHREAD_CHECKS int32_t lock_count; @@ -1162,7 +1174,8 @@ struct s7_scheme { format_data **fdats; int32_t num_fdats, last_error_line; s7_pointer elist_1, elist_2, elist_3, elist_4, elist_5, plist_1, plist_2, plist_2_2, plist_3, qlist_2, clist_1; - gc_list *strings, *vectors, *input_ports, *output_ports, *continuations, *c_objects, *hash_tables, *gensyms, *unknowns, *lambdas, *multivectors, *optlists, *weak_refs; + gc_list *strings, *vectors, *input_ports, *output_ports, *continuations, *c_objects, *hash_tables; + gc_list *gensyms, *unknowns, *lambdas, *multivectors, *optlists, *weak_refs; s7_pointer *setters; s7_int setters_size, setters_loc; s7_pointer *tree_pointers; @@ -1218,7 +1231,7 @@ struct s7_scheme { features_symbol, fill_symbol, float_vector_ref_symbol, float_vector_set_symbol, float_vector_symbol, floor_symbol, flush_output_port_symbol, for_each_symbol, format_symbol, funclet_symbol, gc_symbol, gcd_symbol, gensym_symbol, geq_symbol, get_output_string_symbol, gt_symbol, - hash_table_entries_symbol, hash_table_ref_symbol, hash_table_set_symbol, hash_table_star_symbol, hash_table_symbol, help_symbol, + hash_table_entries_symbol, hash_table_ref_symbol, hash_table_set_symbol, hash_table_symbol, help_symbol, imag_part_symbol, immutable_symbol, inexact_to_exact_symbol, inlet_symbol, int_vector_ref_symbol, int_vector_set_symbol, int_vector_symbol, integer_decode_float_symbol, integer_to_char_symbol, is_aritable_symbol, is_boolean_symbol, is_byte_symbol, is_byte_vector_symbol, is_c_object_symbol, c_object_type_symbol, is_c_pointer_symbol, is_char_alphabetic_symbol, is_char_lower_case_symbol, is_char_numeric_symbol, @@ -1263,7 +1276,7 @@ struct s7_scheme { unlet_symbol, values_symbol, varlet_symbol, vector_append_symbol, vector_dimensions_symbol, vector_fill_symbol, vector_ref_symbol, vector_set_symbol, vector_symbol, - with_input_from_file_symbol, with_input_from_string_symbol, with_output_to_file_symbol, with_output_to_string_symbol, + weak_hash_table_symbol, with_input_from_file_symbol, with_input_from_string_symbol, with_output_to_file_symbol, with_output_to_string_symbol, write_byte_symbol, write_char_symbol, write_string_symbol, write_symbol, local_documentation_symbol, local_signature_symbol, local_setter_symbol, local_iterator_symbol; #if (!WITH_PURE_S7) @@ -1288,8 +1301,8 @@ struct s7_scheme { define_expansion_symbol, baffle_symbol, with_let_symbol, if_symbol, autoload_error_symbol, when_symbol, unless_symbol, begin_symbol, cond_symbol, case_symbol, and_symbol, or_symbol, do_symbol, define_symbol, define_star_symbol, define_constant_symbol, with_baffle_symbol, define_macro_symbol, - define_macro_star_symbol, define_bacro_symbol, define_bacro_star_symbol, letrec_symbol, letrec_star_symbol, - let_star_symbol, key_rest_symbol, key_allow_other_keys_symbol, key_readable_symbol, value_symbol, type_symbol, + define_macro_star_symbol, define_bacro_symbol, define_bacro_star_symbol, letrec_symbol, letrec_star_symbol, let_star_symbol, + key_rest_symbol, key_allow_other_keys_symbol, key_readable_symbol, key_display_symbol, key_write_symbol, value_symbol, type_symbol, baffled_symbol, __func___symbol, set_symbol, body_symbol, class_name_symbol, feed_to_symbol, format_error_symbol, wrong_number_of_args_symbol, read_error_symbol, string_read_error_symbol, syntax_error_symbol, division_by_zero_symbol, no_catch_symbol, io_error_symbol, invalid_escape_function_symbol, wrong_type_arg_symbol, out_of_range_symbol, @@ -1305,15 +1318,16 @@ struct s7_scheme { subtract_cs1, subtract_csn, subtract_sf, subtract_2f, subtract_fs, simple_char_eq, char_equal_s_ic, char_equal_2, char_greater_2, char_less_2, char_position_csi, string_equal_2, substring_to_temp, string_greater_2, string_less_2, symbol_to_string_uncopied, vector_ref_ic, vector_ref_ic_0, vector_ref_ic_1, - vector_ref_ic_2, vector_ref_ic_3, vector_ref_2, vector_ref_2_direct, vector_set_ic, vector_set_3, fv_ref, - fv_ref_3, fv_set, fv_set_unchecked, iv_ref, iv_ref_0, iv_set, bv_ref, bv_set, list_set_ic, hash_table_ref_2, hash_table_ref_ss, hash_table_star_2, + vector_ref_ic_2, vector_ref_ic_3, vector_ref_2, vector_ref_2_direct, vector_ref_3, vector_set_ic, vector_set_3, + fv_ref_2, fv_ref_3, fv_set_3, fv_set_unchecked, iv_ref_2, iv_ref_2i, iv_ref_3, iv_set_3, bv_ref_2, bv_ref_3, bv_set_3, + list_set_ic, hash_table_ref_2, hash_table_ref_ss, hash_table_2, hash_table_ref_car, format_allg, format_allg_no_column, format_just_control_string, format_as_objstr, not_is_pair_s, not_is_null_s, not_is_symbol_s, not_is_number_s, not_is_eq_ss, not_is_eq_sq, not_is_pair_car_s, not_c_c, is_pair_car_s, is_pair_cdr_s, is_pair_cddr_s, is_pair_cadr_s, is_null_cdr, is_null_cddr_s, is_null_cadr_s, is_symbol_cadr_s, is_eq_car, is_eq_car_q, is_eq_caar_q, member_ss, member_sq, memq_2, memq_3, memq_4, memq_any, memq_car, memq_car_2, tree_set_memq_syms, read_line_uncopied, simple_inlet, - lint_let_ref, lint_let_set, or_n, or_2, or_3, and_n, and_2, and_3, and_sc, if_x1, if_x2, if_not_x1, - if_not_x2, if_x_qq, if_x_qa, or_s_direct, and_s_direct, geq_2, or_s_direct_2, and_s_direct_2, or_s_type_2; + lint_let_ref, lint_let_set, or_n, or_2, or_3, and_n, and_2, and_3, if_a_a, if_a_aa, if_not_a_a, + if_not_a_aa, if_x_qq, if_x_qa, or_s_direct, and_s_direct, geq_2, or_s_direct_2, and_s_direct_2, or_s_type_2; #if (!WITH_GMP) s7_pointer multiply_2, multiply_is, multiply_si, multiply_fs, multiply_sf, sqr_ss, invert_1, divide_1r, mod_si, equal_s_ic, @@ -1445,6 +1459,10 @@ static void init_block_lists(s7_scheme * * the malloc pointer block is not currently recognizable). */ +#if S7_DEBUGGING +static s7_int permanent_string_len = 0; +#endif + static inline void liberate(s7_scheme *sc, block_t *p) { if (block_index(p) != TOP_BLOCK_LIST) @@ -1454,7 +1472,14 @@ static inline void liberate(s7_scheme *s } else { - if (block_data(p)) {free(block_data(p)); block_data(p) = NULL;} + if (block_data(p)) + { +#if S7_DEBUGGING + permanent_string_len -= block_size(p); +#endif + free(block_data(p)); + block_data(p) = NULL; + } block_set_index(p, BLOCK_LIST); block_next(p) = (struct block_t *)sc->block_lists[block_index(p)]; sc->block_lists[block_index(p)] = p; @@ -1508,7 +1533,15 @@ static inline char *alloc_permanent_stri if (next_k >= ALLOC_STRING_SIZE) { if (len >= ALLOC_MAX_STRING) - return((char *)malloc(len)); + { +#if S7_DEBUGGING + permanent_string_len += len; +#endif + return((char *)malloc(len)); + } +#if S7_DEBUGGING + permanent_string_len += ALLOC_STRING_SIZE; +#endif sc->alloc_string_cells = (char *)malloc(ALLOC_STRING_SIZE); sc->alloc_string_k = 0; next_k = len; @@ -1772,7 +1805,6 @@ static void init_types(void) t_freeze_p[T_INT_VECTOR] = true; t_freeze_p[T_UNDEFINED] = true; t_freeze_p[T_C_OBJECT] = true; - t_freeze_p[T_LET] = true; t_freeze_p[T_HASH_TABLE] = true; t_freeze_p[T_C_FUNCTION] = true; t_freeze_p[T_CONTINUATION] = true; @@ -1783,7 +1815,7 @@ static void init_types(void) #if WITH_HISTORY #define current_code(Sc) car(Sc->cur_code) -#define set_current_code(Sc, Code) do {if (Sc->history_enabled) {Sc->cur_code = cdr(Sc->cur_code); set_car(Sc->cur_code, Code);} } while (0) +#define set_current_code(Sc, Code) do {Sc->cur_code = cdr(Sc->cur_code); set_car(Sc->cur_code, Code);} while (0) #define mark_current_code(Sc) do {int32_t i; s7_pointer p; for (p = Sc->cur_code, i = 0; i < sc->history_size; i++, p = cdr(p)) gc_mark(car(p));} while (0) #else #define current_code(Sc) Sc->cur_code @@ -1985,7 +2017,7 @@ static void init_types(void) #define is_t_big_ratio(p) (type(p) == T_BIG_RATIO) #define is_t_big_real(p) (type(p) == T_BIG_REAL) #define is_t_big_complex(p) (type(p) == T_BIG_COMPLEX) -#define is_float(p) ((is_real(p)) && (!is_rational(p))) +#define is_float(p) is_t_real(p) /* ((is_real(p)) && (!is_rational(p))) */ #define is_free(p) (type(p) == T_FREE) #define is_free_and_clear(p) (typeflag(p) == T_FREE) @@ -2414,9 +2446,9 @@ static void init_types(void) #define set_tree_collected(p) set_type1_bit(T_Pair(p), T_SHORT_TREE_COLLECTED) #define clear_tree_bits(p) clear_type_bit(T_Pair(p), T_TREE_COLLECTED | T_SHARED) -#define T_FULL_BINDER T_TREE_COLLECTED +/* #define T_FULL_BINDER T_TREE_COLLECTED */ #define T_BINDER T_SHORT_TREE_COLLECTED -#define is_binder(p) has_type1_bit(T_Sym(p), T_BINDER) +/* #define is_binder(p) has_type1_bit(T_Sym(p), T_BINDER) */ #define is_definer_or_binder(p) has_type1_bit(T_Sym(p), T_DEFINER | T_BINDER) #define set_is_binder(p) set_type1_bit(T_Sym(p), T_BINDER) /* this marks "binders" like let */ @@ -2466,7 +2498,12 @@ static void init_types(void) #define ctr3_is_set(p) has_type1_bit(T_Pair(p), T_CTR3_SET) #define set_ctr3_is_set(p) do {set_type1_bit(T_Pair(p), T_CTR3_SET); clear_type_bit(p, T_LINE_NUMBER);} while (0) -#define UNUSED_BITS 0x3e00000000000000 +#define T_FULL_CASE_KEY (1LL << (TYPE_BITS + BIT_ROOM + 33)) +#define T_CASE_KEY (1 << 9) +#define is_case_key(p) has_type1_bit(T_Pos(p), T_CASE_KEY) +#define set_case_key(p) set_type1_bit(T_Sym(p), T_CASE_KEY) + +#define UNUSED_BITS 0x3c00000000000000 #define T_GC_MARK 0x8000000000000000 #define is_marked(p) has_type_bit(p, T_GC_MARK) @@ -2676,9 +2713,15 @@ static void init_types(void) #else #define set_c_call(f, X) do {set_opt2(f, (s7_pointer)(X), F_CALL); set_has_fx(f);} while (0) #endif -#define set_c_call_direct(f, X) set_opt2(f, (s7_pointer)(X), F_CALL) +#define set_c_call_direct(f, X) do {set_opt2(f, (s7_pointer)(X), F_CALL); set_has_fx(f);} while (0) #define set_c_call_unchecked(f, _X_) do {s7_pointer X; X = (s7_pointer)(_X_); set_opt2(f, X, F_CALL); if (X) set_has_fx(f); else clear_has_fx(f);} while (0) - +#if WITH_GCC +#define fx_call(Sc, F) ({s7_pointer _P_; _P_ = F; c_call(_P_)(Sc, car(_P_));}) +#define d_call(Sc, F) ({s7_pointer _P_; _P_ = F; c_call(_P_)(Sc, cdr(_P_));}) +#else +#define fx_call(Sc, F) c_call(F)(Sc, car(F)) +#define d_call(Sc, F) c_call(F)(Sc, cdr(F)) +#endif #define car(p) (T_Pair(p))->object.cons.car #define set_car(p, Val) (T_Pair(p))->object.cons.car = T_Pos(Val) @@ -2906,7 +2949,7 @@ static s7_pointer slot_expression(s7_poi #define float_vector_floats(p) (T_Fvc(p))->object.vector.elements.floats #define is_byte_vector(p) (type(p) == T_BYTE_VECTOR) -#define is_mutable_byte_vector(p) ((typeflag(T_Pos(p)) & (0xff | T_IMMUTABLE)) == T_BYTE_VECTOR) +/* #define is_mutable_byte_vector(p) ((typeflag(T_Pos(p)) & (0xff | T_IMMUTABLE)) == T_BYTE_VECTOR) */ #define byte_vector_length(p) (T_BVc(p))->object.vector.length #define byte_vector_bytes(p) (T_BVc(p))->object.vector.elements.bytes #define byte_vector(p, i) ((T_BVc(p))->object.vector.elements.bytes[i]) @@ -3142,7 +3185,9 @@ enum {DWIND_INIT, DWIND_BODY, DWIND_FINI #define c_object_info(Sc, p) Sc->c_object_types[c_object_type(T_Obj(p))] #define c_object_free(Sc, p) c_object_info(Sc, p)->free #define c_object_ref(Sc, p) c_object_info(Sc, p)->ref +#define c_object_getf(Sc, p) c_object_info(Sc, p)->getter #define c_object_set(Sc, p) c_object_info(Sc, p)->set +#define c_object_setf(Sc, p) c_object_info(Sc, p)->setter #if (!DISABLE_DEPRECATED) #define c_object_print(Sc, p) c_object_info(Sc, p)->print #endif @@ -3378,14 +3423,14 @@ static void slot_set_setter(s7_pointer p do { \ if (Sc->free_heap_top <= Sc->free_heap_trigger) {if (show_gc_stats(Sc)) fprintf(stderr, "%s[%d]: gc\n", __func__, __LINE__); try_to_call_gc(Sc);} \ Obj = (*(--(Sc->free_heap_top))); \ - Obj->debugger_bits = 0; \ + Obj->debugger_bits = 0; Obj->opt1_func = NULL; Obj->opt2_func = NULL; Obj->opt3_func = NULL; \ set_type(Obj, Type); \ } while (0) #define new_cell_no_check(Sc, Obj, Type) \ do { \ Obj = (*(--(Sc->free_heap_top))); \ - Obj->debugger_bits = 0; \ + Obj->debugger_bits = 0; Obj->opt1_func = NULL; Obj->opt2_func = NULL; Obj->opt3_func = NULL; \ set_type(Obj, Type); \ } while (0) #endif @@ -3653,38 +3698,40 @@ static s7_pointer s7_length(s7_scheme *s static bool tree_is_cyclic(s7_scheme *sc, s7_pointer tree); static inline s7_pointer symbol_to_slot(s7_scheme *sc, s7_pointer symbol); static inline s7_pointer make_simple_vector(s7_scheme *sc, s7_int len); +static inline s7_pointer make_symbol_with_length(s7_scheme *sc, const char *name, s7_int len); +static s7_pointer make_symbol(s7_scheme *sc, const char *name); #if S7_DEBUGGING -#define wrap_string(Sc, Str, Len) wrap_string_1(Sc, Str, Len, __func__, __LINE__) -static s7_pointer wrap_string_1(s7_scheme *sc, const char *str, s7_int len, const char *func, int line); + #define wrap_string(Sc, Str, Len) wrap_string_1(Sc, Str, Len, __func__, __LINE__) + static s7_pointer wrap_string_1(s7_scheme *sc, const char *str, s7_int len, const char *func, int line); #else -static s7_pointer wrap_string(s7_scheme *sc, const char *str, s7_int len); + static s7_pointer wrap_string(s7_scheme *sc, const char *str, s7_int len); #endif #if WITH_GMP -static s7_int big_integer_to_s7_int(mpz_t n); + static s7_int big_integer_to_s7_int(mpz_t n); #else -static double next_random(s7_pointer r); + static double next_random(s7_pointer r); #endif #if S7_DEBUGGING && WITH_GCC - static s7_pointer symbol_to_value_unchecked_1(s7_scheme *sc, s7_pointer symbol); - #define symbol_to_value_unchecked(Sc, Sym) check_null_sym(Sc, symbol_to_value_unchecked_1(Sc, Sym), Sym, __LINE__, __func__) + static s7_pointer lookup_1(s7_scheme *sc, s7_pointer symbol); + #define lookup(Sc, Sym) check_null_sym(Sc, lookup_1(Sc, Sym), Sym, __LINE__, __func__) static s7_pointer check_null_sym(s7_scheme *sc, s7_pointer p, s7_pointer sym, int32_t line, const char *func); - #define symbol_to_value_unexamined(Sc, Sym) symbol_to_value_unchecked_1(Sc, Sym) + #define lookup_unexamined(Sc, Sym) lookup_1(Sc, Sym) #else - static inline s7_pointer symbol_to_value_unchecked(s7_scheme *sc, s7_pointer symbol); - #define symbol_to_value_unexamined(Sc, Sym) symbol_to_value_unchecked(Sc, Sym) + static inline s7_pointer lookup(s7_scheme *sc, s7_pointer symbol); + #define lookup_unexamined(Sc, Sym) lookup(Sc, Sym) #endif #if WITH_GCC #if S7_DEBUGGING - #define symbol_to_value_checked(Sc, Sym) ({s7_pointer _x_; _x_ = symbol_to_value_unchecked_1(Sc, Sym); ((_x_) ? _x_ : unbound_variable(Sc, Sym));}) + #define lookup_checked(Sc, Sym) ({s7_pointer _x_; _x_ = lookup_1(Sc, Sym); ((_x_) ? _x_ : unbound_variable(Sc, Sym));}) #else - #define symbol_to_value_checked(Sc, Sym) ({s7_pointer _x_; _x_ = symbol_to_value_unchecked(Sc, Sym); ((_x_) ? _x_ : unbound_variable(Sc, Sym));}) + #define lookup_checked(Sc, Sym) ({s7_pointer _x_; _x_ = lookup(Sc, Sym); ((_x_) ? _x_ : unbound_variable(Sc, Sym));}) #endif #else - #define symbol_to_value_checked(Sc, Sym) symbol_to_value_unchecked(Sc, Sym) + #define lookup_checked(Sc, Sym) lookup(Sc, Sym) #endif static s7_pointer find_method(s7_scheme *sc, s7_pointer env, s7_pointer symbol); @@ -3718,20 +3765,19 @@ static s7_pointer simple_out_of_range_er #if (!HAVE_COMPLEX_NUMBERS) -static s7_pointer no_complex_numbers_string; + static s7_pointer no_complex_numbers_string; #endif /* ---------------- evaluator ops ---------------- */ -/* C=constant, S=symbol, A=fx-callable, Q=quote, D=list of constants */ +/* C=constant, S=symbol, A=fx-callable, Q=quote, D=list of constants, FX=list of A's */ enum {OP_UNOPT, HOP_UNOPT, OP_SYM, HOP_SYM, OP_CON, HOP_CON, OP_PAIR_SYM, HOP_PAIR_SYM, OP_PAIR_PAIR, HOP_PAIR_PAIR, OP_PAIR_ANY, HOP_PAIR_ANY, OP_SAFE_C_D, HOP_SAFE_C_D, OP_SAFE_C_AND2, HOP_SAFE_C_AND2, OP_SAFE_C_OR2, HOP_SAFE_C_OR2, OP_SAFE_C_S, HOP_SAFE_C_S, OP_SAFE_CAR_S, HOP_SAFE_CAR_S, OP_SAFE_CDR_S, HOP_SAFE_CDR_S, OP_SAFE_CADR_S, HOP_SAFE_CADR_S, OP_SAFE_IS_PAIR_S, HOP_SAFE_IS_PAIR_S, OP_SAFE_IS_NULL_S, HOP_SAFE_IS_NULL_S, OP_SAFE_IS_SYMBOL_S, HOP_SAFE_IS_SYMBOL_S, /* order matters here */ - OP_SAFE_C_SS, HOP_SAFE_C_SS, OP_SAFE_C_SC, HOP_SAFE_C_SC, OP_SAFE_C_CS, HOP_SAFE_C_CS, - OP_SAFE_C_CQ, HOP_SAFE_C_CQ, + OP_SAFE_C_SS, HOP_SAFE_C_SS, OP_SAFE_C_SC, HOP_SAFE_C_SC, OP_SAFE_C_CS, HOP_SAFE_C_CS, OP_SAFE_C_CQ, HOP_SAFE_C_CQ, OP_SAFE_C_SSS, HOP_SAFE_C_SSS, OP_SAFE_C_SCS, HOP_SAFE_C_SCS, OP_SAFE_C_SSC, HOP_SAFE_C_SSC, OP_SAFE_C_CSS, HOP_SAFE_C_CSS, OP_SAFE_C_SCC, HOP_SAFE_C_SCC, OP_SAFE_C_CSC, HOP_SAFE_C_CSC, OP_SAFE_C_CCS, HOP_SAFE_C_CCS, OP_SAFE_C_ALL_S, HOP_SAFE_C_ALL_S, @@ -3763,8 +3809,7 @@ enum {OP_UNOPT, HOP_UNOPT, OP_SYM, HOP_S OP_SAFE_C_A, HOP_SAFE_C_A, OP_SAFE_C_AA, HOP_SAFE_C_AA, OP_SAFE_C_AAA, HOP_SAFE_C_AAA, OP_SAFE_C_AAAA, HOP_SAFE_C_AAAA, OP_SAFE_C_FX, HOP_SAFE_C_FX, OP_SAFE_C_ALL_CA, HOP_SAFE_C_ALL_CA, OP_SAFE_C_SSA, HOP_SAFE_C_SSA, OP_SAFE_C_SAS, HOP_SAFE_C_SAS, - OP_SAFE_C_CSA, HOP_SAFE_C_CSA, OP_SAFE_C_SCA, HOP_SAFE_C_SCA, - OP_SAFE_C_CAC, HOP_SAFE_C_CAC, + OP_SAFE_C_CSA, HOP_SAFE_C_CSA, OP_SAFE_C_SCA, HOP_SAFE_C_SCA, OP_SAFE_C_CAC, HOP_SAFE_C_CAC, OP_SAFE_C_opAq, HOP_SAFE_C_opAq, OP_SAFE_C_opAAq, HOP_SAFE_C_opAAq, OP_SAFE_C_opAAAq, HOP_SAFE_C_opAAAq, OP_SAFE_C_S_opAq, HOP_SAFE_C_S_opAq, OP_SAFE_C_opAq_S, HOP_SAFE_C_opAq_S, OP_SAFE_C_S_opAAq, HOP_SAFE_C_S_opAAq, OP_SAFE_C_S_opAAAq, HOP_SAFE_C_S_opAAAq, @@ -3826,6 +3871,7 @@ enum {OP_UNOPT, HOP_UNOPT, OP_SYM, HOP_S OP_S, OP_S_S, OP_S_C, OP_S_A, OP_C_FA_1, OP_S_AA, OP_GOTO, OP_GOTO_A, OP_ITERATE, OP_CONTINUATION_A, OP_VECTOR_A, OP_STRING_A, OP_C_OBJECT_A, OP_PAIR_A, OP_HASH_TABLE_A, OP_ENVIRONMENT_C, OP_ENVIRONMENT_A, + OP_VECTOR_AA, OP_UNKNOWN, OP_UNKNOWN_ALL_S, OP_UNKNOWN_FX, OP_UNKNOWN_G, OP_UNKNOWN_GG, OP_UNKNOWN_A, OP_UNKNOWN_AA, OP_GC_PROTECT, @@ -3854,45 +3900,37 @@ enum {OP_UNOPT, HOP_UNOPT, OP_SYM, HOP_S OP_FOR_EACH, OP_FOR_EACH_1, OP_FOR_EACH_2, OP_FOR_EACH_3, OP_MAP, OP_MAP_1, OP_MAP_2, OP_MAP_GATHER, OP_MAP_GATHER_1, OP_MAP_GATHER_2, OP_MAP_GATHER_3, OP_BARRIER, OP_DEACTIVATE_GOTO, - OP_DEFINE_BACRO, OP_DEFINE_BACRO_STAR, OP_GET_OUTPUT_STRING, OP_SORT, OP_SORT1, OP_SORT2, OP_SORT3, OP_SORT_PAIR_END, OP_SORT_VECTOR_END, OP_SORT_STRING_END, OP_EVAL_STRING, OP_MEMBER_IF, OP_ASSOC_IF, OP_MEMBER_IF1, OP_ASSOC_IF1, - - OP_LAMBDA_UNCHECKED, OP_LET_UNCHECKED, - OP_CATCH_1, OP_CATCH_2, OP_CATCH_ALL, - + OP_LAMBDA_UNCHECKED, OP_LET_UNCHECKED, OP_CATCH_1, OP_CATCH_2, OP_CATCH_ALL, OP_SET_UNCHECKED, OP_SET_SYMBOL_C, OP_SET_SYMBOL_S, OP_SET_SYMBOL_P, OP_SET_SYMBOL_A, OP_SET_SYMBOL_opSq, OP_SET_SYMBOL_opDq, OP_SET_SYMBOL_opSSq, OP_SET_NORMAL, OP_SET_PAIR, OP_SET_DILAMBDA, OP_SET_DILAMBDA_P, OP_SET_DILAMBDA_P_1, OP_SET_PAIR_A, OP_SET_PAIR_P, OP_SET_PAIR_ZA, - OP_SET_PAIR_P_1, OP_SET_WITH_SETTER, OP_SET_PWS, OP_SET_LET_S, OP_SET_LET_FX, - OP_SET_SAFE, + OP_SET_PAIR_P_1, OP_SET_WITH_SETTER, OP_SET_PWS, OP_SET_LET_S, OP_SET_LET_FX, OP_SET_SAFE, OP_INCREMENT_1, OP_DECREMENT_1, OP_SET_CONS, OP_INCREMENT_SS, OP_INCREMENT_SSS, OP_INCREMENT_SP, OP_INCREMENT_SA, OP_INCREMENT_SAA, - OP_LETREC_UNCHECKED, OP_LETREC_STAR_UNCHECKED, OP_COND_UNCHECKED, OP_LAMBDA_STAR_UNCHECKED, OP_DO_UNCHECKED, OP_DEFINE_UNCHECKED, OP_DEFINE_STAR_UNCHECKED, OP_DEFINE_FUNCHECKED, OP_DEFINE_CONSTANT_UNCHECKED, OP_DEFINE_WITH_SETTER, OP_DEFINE_MACRO_WITH_SETTER, - OP_LET_NO_VARS, OP_NAMED_LET, OP_NAMED_LET_NO_VARS, OP_NAMED_LET_STAR, - OP_LET_C, OP_LET_S, OP_LET_S_P, OP_LET_ALL_C, OP_LET_ALL_S, OP_LET_FX, - OP_LET_STAR_FX, OP_LET_STAR_A2, OP_LET_STAR_A, OP_LET_opDq, OP_LET_opSSq, OP_LET_opSSq_E, OP_LET_opaSSq, OP_LET_opaSSq_E, - OP_LET_opSq, OP_LET_ALL_opSq, OP_LET_opSq_P, OP_LET_CAR, OP_LET_ONE, OP_LET_ONE_1, OP_LET_ONE_P, OP_LET_ONE_P_1, - OP_LET_A, OP_LET_A_P, - - OP_CASE_A_E_S, OP_CASE_A_I_S, OP_CASE_A_G_S, OP_CASE_A_E_G, OP_CASE_A_G_G, - OP_CASE_S_E_S, OP_CASE_S_I_S, OP_CASE_S_G_S, OP_CASE_S_E_G, OP_CASE_S_G_G, - OP_CASE_P_E_S, OP_CASE_P_I_S, OP_CASE_P_G_S, OP_CASE_P_E_G, OP_CASE_P_G_G, - OP_CASE_E_S, OP_CASE_I_S, OP_CASE_G_S, OP_CASE_E_G, OP_CASE_G_G, + OP_LET_NO_VARS, OP_NAMED_LET, OP_NAMED_LET_NO_VARS, OP_NAMED_LET_STAR, OP_LET_FX, OP_LET_STAR_FX, + OP_LET_opSSq, OP_LET_opSSq_E, OP_LET_opaSSq, OP_LET_opaSSq_E, + OP_LET_ONE, OP_LET_ONE_1, OP_LET_ONE_P, OP_LET_ONE_P_1, OP_LET_A, OP_LET_A_P, OP_LET_A_A, + + OP_CASE_A_E_S, OP_CASE_A_I_S, OP_CASE_A_G_S, OP_CASE_A_E_G, OP_CASE_A_G_G, OP_CASE_A_S_S, OP_CASE_A_S_G, + OP_CASE_S_E_S, OP_CASE_S_I_S, OP_CASE_S_G_S, OP_CASE_S_E_G, OP_CASE_S_G_G, OP_CASE_S_S_S, OP_CASE_S_S_G, + OP_CASE_P_E_S, OP_CASE_P_I_S, OP_CASE_P_G_S, OP_CASE_P_E_G, OP_CASE_P_G_G, OP_CASE_P_S_S, OP_CASE_P_S_G, + OP_CASE_E_S, OP_CASE_I_S, OP_CASE_G_S, OP_CASE_E_G, OP_CASE_G_G, OP_CASE_S_S, OP_CASE_S_G, OP_IF_UNCHECKED, OP_AND_P, OP_AND_P1, OP_AND_AP, OP_AND_SAFE_P, OP_AND_SAFE_AA, OP_AND_PAIR_P, OP_OR_P, OP_OR_P1, OP_OR_AP, OP_OR_SAFE_P, OP_OR_SAFE_AA, OP_COND_FEED, OP_COND_FEED_1, OP_WHEN_S, OP_WHEN_A, OP_WHEN_P, OP_UNLESS_S, OP_UNLESS_A, OP_UNLESS_P, OP_IF_S_P, OP_IF_S_P_P, OP_IF_S_R, OP_IF_S_N, OP_IF_S_N_N, - OP_IF_C_P, OP_IF_C_P_P, OP_IF_C_R, OP_IF_C_N, OP_IF_C_N_N, + OP_IF_D_P, OP_IF_D_P_P, OP_IF_D_R, OP_IF_D_N, OP_IF_D_N_N, OP_IF_CS_P, OP_IF_CS_P_P, OP_IF_CS_R, OP_IF_CS_N, OP_IF_CS_N_N, OP_IF_CSS_P, OP_IF_CSS_P_P, OP_IF_CSS_R, OP_IF_CSS_N, OP_IF_CSS_N_N, OP_IF_CSC_P, OP_IF_CSC_P_P, OP_IF_CSC_R, OP_IF_CSC_N, OP_IF_CSC_N_N, @@ -3907,9 +3945,7 @@ enum {OP_UNOPT, HOP_UNOPT, OP_SYM, HOP_S OP_IF_ANDP_P, OP_IF_ANDP_P_P, OP_IF_ANDP_R, OP_IF_ANDP_N, OP_IF_ANDP_N_N, OP_IF_ORP_P, OP_IF_ORP_P_P, OP_IF_ORP_R, OP_IF_ORP_N, OP_IF_ORP_N_N, OP_IF_OR2_P, OP_IF_OR2_P_P, OP_IF_OR2_R, OP_IF_OR2_N, OP_IF_OR2_N_N, - - OP_IF_PPP, OP_IF_PP, OP_IF_PR, OP_IF_PRR, - OP_WHEN_PP, OP_UNLESS_PP, + OP_IF_PPP, OP_IF_PP, OP_IF_PR, OP_IF_PRR, OP_WHEN_PP, OP_UNLESS_PP, OP_COND_FX, OP_COND_FX_2, OP_COND_FX_P, OP_COND_FX_1P_ELSE, OP_COND_FX_2P_ELSE, OP_SIMPLE_DO, OP_SIMPLE_DO_STEP, OP_SAFE_DOTIMES, OP_SAFE_DOTIMES_STEP, OP_SAFE_DOTIMES_STEP_P, OP_SAFE_DOTIMES_STEP_O, @@ -3930,6 +3966,8 @@ enum {OP_UNOPT, HOP_UNOPT, OP_SYM, HOP_S OP_SAFE_C_PA_1, OP_SAFE_C_PA_MV, OP_SET_WITH_LET_1, OP_SET_WITH_LET_2, OP_S7_LET, + + OP_D1, OP_D2, OP_D3, OP_D4, OP_D5, OP_D6, OP_D7, OP_D8, OP_MAX_DEFINED_1}; #define OP_MAX_DEFINED (OP_MAX_DEFINED_1 + 1) @@ -3944,8 +3982,7 @@ static const char* op_names[OP_MAX_DEFIN "safe_c_d", "h_safe_c_d", "safe_c_and2", "h_safe_c_and2", "safe_c_or2", "h_safe_c_or2", "safe_c_s", "h_safe_c_s", "safe_car_s", "h_safe_car_s", "safe_cdr_s", "h_safe_cdr_s", "safe_cadr_s", "h_safe_cadr_s", "safe_is_pair_s", "h_safe_is_pair_s", "safe_is_null_s", "h_safe_is_null_s", "safe_is_symbol_s", "h_safe_is_symbol_s", - "safe_c_ss", "h_safe_c_ss", "safe_c_sc", "h_safe_c_sc", "safe_c_cs", "h_safe_c_cs", - "safe_c_cq", "h_safe_c_cq", + "safe_c_ss", "h_safe_c_ss", "safe_c_sc", "h_safe_c_sc", "safe_c_cs", "h_safe_c_cs", "safe_c_cq", "h_safe_c_cq", "safe_c_sss", "h_safe_c_sss", "safe_c_scs", "h_safe_c_scs", "safe_c_ssc", "h_safe_c_ssc", "safe_c_css", "h_safe_c_css", "safe_c_scc", "h_safe_c_scc", "safe_c_csc", "h_safe_c_csc", "safe_c_ccs", "h_safe_c_ccs", "safe_c_all_s", "h_safe_c_all_s", @@ -3977,8 +4014,7 @@ static const char* op_names[OP_MAX_DEFIN "safe_c_a", "h_safe_c_a", "safe_c_aa", "h_safe_c_aa", "safe_c_aaa", "h_safe_c_aaa", "safe_c_aaaa", "h_safe_c_aaaa", "safe_c_fx", "h_safe_c_fx", "safe_c_all_ca", "h_safe_c_all_ca", "safe_c_ssa", "h_safe_c_ssa", "safe_c_sas", "h_safe_c_sas", - "safe_c_csa", "h_safe_c_csa", "safe_c_sca", "h_safe_c_sca", - "safe_c_cac", "h_safe_c_cac", + "safe_c_csa", "h_safe_c_csa", "safe_c_sca", "h_safe_c_sca", "safe_c_cac", "h_safe_c_cac", "safe_c_opaq", "h_safe_c_opaq", "safe_c_opaaq", "h_safe_c_opaaq", "safe_c_opaaaq", "h_safe_c_opaaaq", "safe_c_s_opaq", "h_safe_c_s_opaq", "safe_c_opaq_s", "h_safe_c_opaq_s", "safe_c_s_opaaq", "h_safe_c_s_opaaq", "safe_c_s_opaaaq", "h_safe_c_s_opaaaq", @@ -4037,6 +4073,7 @@ static const char* op_names[OP_MAX_DEFIN "s", "s_s", "s_c", "s_a", "c_fa_1", "s_aa", "goto", "goto_a", "iterate", "continuation_a", "vector_a", "string_a", "c_object_a", "pair_a", "hash_table_a", "environment_c", "environment_a", + "vector_aa", "unknown", "unknown_all_s", "unknown_fx", "unknown_g", "unknown_gg", "unknown_a", "unknown_aa", "gc_protect", @@ -4064,46 +4101,38 @@ static const char* op_names[OP_MAX_DEFIN "for_each", "for_each_1", "for_each_2", "for_each_3", "map", "map_1", "map_2", "map_gather", "map_gather_1", "map_gather_2", "map_gather_3", "barrier", "deactivate_goto", - "define_bacro", "define_bacro*", "get_output_string", "sort", "sort1", "sort2", "sort3", "sort_pair_end", "sort_vector_end", "sort_string_end", "eval_string", "member_if", "assoc_if", "member_if1", "assoc_if1", - - "lambda_unchecked", "let_unchecked", - "catch_1", "catch_2", "catch_all", - + "lambda_unchecked", "let_unchecked", "catch_1", "catch_2", "catch_all", "set_unchecked", "set_symbol_c", "set_symbol_s", "set_symbol_p", "set_symbol_a", "set_symbol_opsq", "set_symbol_opdq", "set_symbol_opssq", "set_normal", "set_pair", "set_dilambda", "set_dilambda_p", "set_dilambda_p_1", "set_pair_a", "set_pair_p", "set_pair_za", - "set_pair_p_1", "set_with_setter", "set_pws", "set_let_s", "set_let_fx", - "set_safe", + "set_pair_p_1", "set_with_setter", "set_pws", "set_let_s", "set_let_fx", "set_safe", "increment_1", "decrement_1", "set_cons", "increment_ss", "increment_sss", "increment_sp", "increment_sa", "increment_saa", - "letrec_unchecked", "letrec*_unchecked", "cond_unchecked", "lambda*_unchecked", "do_unchecked", "define_unchecked", "define*_unchecked", "define_funchecked", "define_constant_unchecked", "define_with_setter", "define_macro_with_setter", - "let_no_vars", "named_let", "named_let_no_vars", "named_let*", - "let_c", "let_s", "let_s_p", "let_all_c", "let_all_s", "let_fx", - "let*_fx", "let*_a2", "let*_a", "let_opdq", "let_opssq", "let_opssq_e", "let_opassq", "let_opassq_e", - "let_opsq", "let_all_opsq", "let_opsq_p", "let_car", "let_one", "let_one_1", "let_one_p", "let_one_p_1", - "let_a", "let_a_p", - - "case_a_e_s", "case_a_i_s", "case_a_g_s", "case_a_e_g", "case_a_g_g", - "case_s_e_s", "case_s_i_s", "case_s_g_s", "case_s_e_g", "case_s_g_g", - "case_p_e_s", "case_p_i_s", "case_p_g_s", "case_p_e_g", "case_p_g_g", - "case_e_s", "case_i_s", "case_g_s", "case_e_g", "case_g_g", + "let_no_vars", "named_let", "named_let_no_vars", "named_let*", "let_fx", "let*_fx", + "let_opssq", "let_opssq_e", "let_opassq", "let_opassq_e", + "let_one", "let_one_1", "let_one_p", "let_one_p_1", "let_a", "let_a_p", "let_a_a", + + "case_a_e_s", "case_a_i_s", "case_a_g_s", "case_a_e_g", "case_a_g_g", "case_a_s_s", "case_a_s_g", + "case_s_e_s", "case_s_i_s", "case_s_g_s", "case_s_e_g", "case_s_g_g", "case_s_s_s", "case_s_s_g", + "case_p_e_s", "case_p_i_s", "case_p_g_s", "case_p_e_g", "case_p_g_g", "case_p_s_s", "case_p_s_g", + "case_e_s", "case_i_s", "case_g_s", "case_e_g", "case_g_g", "case_s_s", "case_s_g", "if_unchecked", "and_p", "and_p1", "and_ap", "and_safe_p", "and_safe_aa", "and_pair_p", "or_p", "or_p1", "or_ap", "or_safe_p", "or_safe_aa", "cond_feed", "cond_feed_1", "when_s", "when_a", "when_p", "unless_s", "unless_a", "unless_p", "if_s_p", "if_s_p_p", "if_s_r", "if_s_n", "if_s_n_n", - "if_c_p", "if_c_p_p", "if_c_r", "if_c_n", "if_c_n_n", + "if_d_p", "if_d_p_p", "if_d_r", "if_d_n", "if_d_n_n", "if_cs_p", "if_cs_p_p", "if_cs_r", "if_cs_n", "if_cs_n_n", "if_css_p", "if_css_p_p", "if_css_r","if_css_n", "if_css_n_n", "if_csc_p", "if_csc_p_p", "if_csc_r", "if_csc_n", "if_csc_n_n", @@ -4118,9 +4147,7 @@ static const char* op_names[OP_MAX_DEFIN "if_andp_p", "if_andp_p_p", "if_andp_r", "if_andp_n", "if_andp_n_n", "if_orp_p", "if_orp_p_p", "if_orp_r","if_orp_n", "if_orp_n_n", "if_or2_p", "if_or2_p_p", "if_or2_r","if_or2_n", "if_or2_n_n", - - "if_ppp", "if_pp", "if_pr", "if_prr", - "when_pp", "unless_pp", + "if_ppp", "if_pp", "if_pr", "if_prr", "when_pp", "unless_pp", "cond_fx", "cond_fx_2", "cond_fx_p", "cond_fx_1p_else", "cond_fx_2p_else", "simple_do", "simple_do_step", "safe_dotimes", "safe_dotimes_step", "safe_dotimes_step_p", "safe_dotimes_step_o", @@ -4150,7 +4177,6 @@ static const char* op_names[OP_MAX_DEFIN #define in_reader(Sc) ((sc->cur_op >= OP_READ_LIST) && (sc->cur_op <= OP_READ_DONE) && (is_input_port(Sc->input_port))) #define is_safe_c_op(op) ((op >= OP_SAFE_C_D) && (op < OP_THUNK)) #define is_unknown_op(op) ((op >= OP_UNKNOWN) && (op <= OP_UNKNOWN_AA)) -#define is_callable_c_op(op) ((is_safe_c_op(op)) || (op >= OP_SAFE_C_PP)) /* used only in check_set */ #define is_fxa_op(op) ((op < OP_SAFE_C_D) || (op >= OP_SAFE_C_A)) #define is_h_safe_c_d(P) ((is_optimized(P)) && (optimize_op(P) >= HOP_SAFE_C_D) && (optimize_op(P) < OP_SAFE_C_S) && ((optimize_op(P) & 1) != 0)) #define is_h_safe_c_s(P) ((is_optimized(P)) && (optimize_op(P) >= HOP_SAFE_C_S) && (optimize_op(P) <= HOP_SAFE_IS_SYMBOL_S) && ((optimize_op(P) & 1) != 0)) @@ -4160,7 +4186,7 @@ static bool is_h_optimized(s7_pointer p) { return((is_optimized(p)) && ((optimize_op(p) & 1) != 0) && - (!is_unknown_op(optimize_op(p)))); + (optimize_op(p) < OP_S)); } /* -------- */ @@ -4341,7 +4367,7 @@ static s7_pointer missing_method_error(s #define check_boolean_not_method(Sc, Checker, Method, Args) \ { \ s7_pointer p; \ - p = symbol_to_value_unchecked(sc, cadar(Args)); \ + p = lookup(sc, cadar(Args)); \ if (Checker(p)) return(Sc->F); \ if (!has_methods(p)) return(Sc->T); \ return((apply_boolean_method(Sc, p, Method) == sc->F) ? sc->T : sc->F); \ @@ -4397,7 +4423,6 @@ static s7_pointer method_or_bust_with_ty return(simple_wrong_type_argument_with_type(sc, method, obj, typ)); } - #define eval_error_any(Sc, ErrType, ErrMsg, Len, Obj) \ return(s7_error(Sc, ErrType, set_elist_2(Sc, wrap_string(Sc, ErrMsg, Len), Obj))) @@ -4420,7 +4445,6 @@ static s7_pointer method_or_bust_with_ty return(s7_error(Sc, Sc->syntax_error_symbol, set_elist_4(Sc, wrap_string(Sc, ErrMsg, Len), Caller, Name, Obj))) - /* -------------------------------- constants -------------------------------- */ s7_pointer s7_f(s7_scheme *sc) {return(sc->F);} @@ -4612,6 +4636,7 @@ s7_inline s7_int s7_gc_protect(s7_scheme return(loc); } +#if (!DISABLE_DEPRECATED) void s7_gc_unprotect(s7_scheme *sc, s7_pointer x) { s7_int i; @@ -4623,6 +4648,7 @@ void s7_gc_unprotect(s7_scheme *sc, s7_p return; } } +#endif void s7_gc_unprotect_at(s7_scheme *sc, s7_int loc) { @@ -5040,24 +5066,24 @@ static void add_gensym(s7_scheme *sc, s7 } -#define add_c_object(sc, p) add_to_gc_list(sc->c_objects, p) -#define add_hash_table(sc, p) add_to_gc_list(sc->hash_tables, p) -#define add_string(sc, p) add_to_gc_list(sc->strings, p) -#define add_input_port(sc, p) add_to_gc_list(sc->input_ports, p) -#define add_output_port(sc, p) add_to_gc_list(sc->output_ports, p) -#define add_continuation(sc, p) add_to_gc_list(sc->continuations, p) -#define add_unknown(sc, p) add_to_gc_list(sc->unknowns, p) -#define add_vector(sc, p) add_to_gc_list(sc->vectors, p) -#define add_multivector(sc, p) add_to_gc_list(sc->multivectors, p) -#define add_lambda(sc, p) add_to_gc_list(sc->lambdas, p) -#define add_optlist(sc, p) add_to_gc_list(sc->optlists, p) -#define add_weak_ref(sc, p) add_to_gc_list(sc->weak_refs, p) +#define add_c_object(sc, p) add_to_gc_list(sc->c_objects, p) +#define add_hash_table(sc, p) add_to_gc_list(sc->hash_tables, p) +#define add_string(sc, p) add_to_gc_list(sc->strings, p) +#define add_input_port(sc, p) add_to_gc_list(sc->input_ports, p) +#define add_output_port(sc, p) add_to_gc_list(sc->output_ports, p) +#define add_continuation(sc, p) add_to_gc_list(sc->continuations, p) +#define add_unknown(sc, p) add_to_gc_list(sc->unknowns, p) +#define add_vector(sc, p) add_to_gc_list(sc->vectors, p) +#define add_multivector(sc, p) add_to_gc_list(sc->multivectors, p) +#define add_lambda(sc, p) add_to_gc_list(sc->lambdas, p) +#define add_optlist(sc, p) add_to_gc_list(sc->optlists, p) +#define add_weak_ref(sc, p) add_to_gc_list(sc->weak_refs, p) #if WITH_GMP -#define add_bigint(sc, p) add_to_gc_list(sc->bigints, p) -#define add_bigratio(sc, p) add_to_gc_list(sc->bigratios, p) -#define add_bigreal(sc, p) add_to_gc_list(sc->bigreals, p) -#define add_bignumber(sc, p) add_to_gc_list(sc->bignumbers, p) +#define add_bigint(sc, p) add_to_gc_list(sc->bigints, p) +#define add_bigratio(sc, p) add_to_gc_list(sc->bigratios, p) +#define add_bigreal(sc, p) add_to_gc_list(sc->bigreals, p) +#define add_bignumber(sc, p) add_to_gc_list(sc->bignumbers, p) #endif static void init_gc_caches(s7_scheme *sc) @@ -5269,7 +5295,7 @@ static void mark_stack_1(s7_pointer p, s static void mark_stack(s7_pointer p) { - /* we can have a bare stack awaiting a continuation to hold it if the new_cell for the continuation triggers the GC! But we need a top-of-stack?? */ + /* we can have a bare stack waiting for a continuation to hold it if the new_cell for the continuation triggers the GC! But we need a top-of-stack?? */ mark_stack_1(p, temp_stack_top(p)); } @@ -5500,7 +5526,7 @@ static void mark_rootlet(s7_scheme *sc) while (tmp < top) gc_mark(slot_value(*tmp++)); /* slot_setter is handled below with an explicit list -- more code than its worth probably */ - /* we're not marking slot_symbol above which makes me worry that a top-level gensym won't protected + /* we're not marking slot_symbol above which makes me worry that a top-level gensym won't be protected * (apply define (gensym) '(32)), then try to get the GC to clobber {gensym}-0, * but I can't get it to break, so they must be protected somehow; apparently they are * removed from the heap! At least: @@ -5659,12 +5685,10 @@ static int64_t gc(s7_scheme *sc) set_mark(sc->protected_setter_symbols); /* now protect recent allocations using the free_heap cells above the current free_heap_top (if any). - * * cells above sc->free_heap_top might be malloc'd garbage (after heap reallocation), so we keep track of * where the last actually freed cells were after the previous GC call. We're trying to * GC protect the previous GC_TEMPS_SIZE allocated pointers so that the caller doesn't have * to gc-protect every temporary cell. - * * There's one remaining possible problem. s7_remove_from_heap frees cells outside * the GC and might push free_heap_top beyond its previous_free_heap_top, then * an immediate explicit gc call might not see those temp cells. @@ -5702,7 +5726,7 @@ static int64_t gc(s7_scheme *sc) { \ if (!is_free_and_clear(p)) \ { \ - p->debugger_bits = 0; \ + p->debugger_bits = 0; p->opt1_func = NULL; p->opt2_func = NULL; p->opt3_func = NULL; \ if (has_odd_bits(p)) \ {char *s; fprintf(stderr, "odd bits: %s\n", s = describe_type_bits(sc, p)); free(s);} \ clear_type(p); \ @@ -5805,7 +5829,7 @@ static void resize_heap_to(s7_scheme *sc s7_show_let(sc); abort(); #endif - s7_error(sc, s7_make_symbol(sc, "heap-too-big"), set_elist_1(sc, wrap_string(sc, "heap has grown past (*s7* 'max-heap-size)", 41))); + s7_error(sc, make_symbol(sc, "heap-too-big"), set_elist_1(sc, wrap_string(sc, "heap has grown past (*s7* 'max-heap-size)", 41))); } } @@ -5876,7 +5900,6 @@ s7_pointer s7_gc_on(s7_scheme *sc, bool return(s7_make_boolean(sc, on)); } - #define ALLOC_POINTER_SIZE 256 static s7_cell *alloc_pointer(s7_scheme *sc) { @@ -5933,6 +5956,9 @@ static void free_cell(s7_scheme *sc, s7_ /* abort(); */ } p->debugger_bits = 0; + p->opt1_func = NULL; + p->opt2_func = NULL; + p->opt3_func = NULL; p->explicit_free_line = line; #endif clear_type(p); @@ -5968,27 +5994,31 @@ static void check_heap_location(s7_schem s7_int i; char *s; heap_block_t *hp; - fprintf(stderr, "%s[%d]: sc->heap[%ld] (%p) is not %p\n", func, line, loc, ((loc >= 0) && (loc < sc->heap_size)) ? sc->heap[loc] : NULL, x); + fprintf(stderr, "%s[%d]: sc->heap[%" print_s7_int "] (%p) is not %p\n", func, line, loc, ((loc >= 0) && (loc < sc->heap_size)) ? sc->heap[loc] : NULL, x); for (i = 0; i < sc->heap_size; i++) if (sc->heap[i] == x) break; if (i < sc->heap_size) - fprintf(stderr, " correct location: %ld\n", i); + fprintf(stderr, " correct location: %" print_s7_int "\n", i); else fprintf(stderr, " %p is not in the heap\n", x); fprintf(stderr, " bits: %s\n", s = describe_type_bits(sc, x)); free(s); - fprintf(stderr, "blocks (x is %ld, big_hloc: %ld):\n", (intptr_t)x, ((s7_big_pointer)x)->big_hloc); + fprintf(stderr, "blocks (x is %" print_s7_int ", big_hloc: %" print_s7_int "):\n", (intptr_t)x, ((s7_big_pointer)x)->big_hloc); for (hp = sc->heap_blocks; hp; hp = hp->next) { - fprintf(stderr, " %ld: %ld to %ld\n", hp->offset, hp->start, hp->end); + fprintf(stderr, " %" print_s7_int ": %" print_s7_int " to %" print_s7_int "\n", hp->offset, hp->start, hp->end); if (((intptr_t)x >= hp->start) && ((intptr_t)x < hp->end)) - fprintf(stderr, " (found it here: %ld\n", hp->offset + (((intptr_t)x - hp->start) / sizeof(s7_cell))); + fprintf(stderr, " (found it here: %" print_s7_int "\n", hp->offset + (((intptr_t)x - hp->start) / sizeof(s7_cell))); } abort(); } } #endif +#if S7_DEBUGGING +static int petrified_pointers = 0; +#endif + static inline s7_pointer petrify(s7_scheme *sc, s7_pointer x) { s7_pointer p; @@ -5996,6 +6026,7 @@ static inline s7_pointer petrify(s7_sche loc = heap_location(sc, x); #if S7_DEBUGGING check_heap_location(sc, x, loc, __func__, __LINE__); + petrified_pointers++; #endif p = (s7_pointer)alloc_big_pointer(sc, loc); sc->heap[loc] = p; @@ -6061,6 +6092,7 @@ static inline void s7_remove_from_heap(s loc = heap_location(sc, x); #if S7_DEBUGGING check_heap_location(sc, x, loc, __func__, __LINE__); + petrified_pointers++; #endif sc->heap[loc] = (s7_pointer)alloc_big_pointer(sc, loc); free_cell(sc, sc->heap[loc]); @@ -6257,6 +6289,7 @@ static void push_stack(s7_scheme *sc, op Sc->stack_end[3] = (s7_pointer)Op; \ Sc->stack_end += 4; \ } while (0) + #define push_stack_no_let(Sc, Op, Args, Code) \ do { \ Sc->stack_end[0] = Code; \ @@ -6264,11 +6297,13 @@ static void push_stack(s7_scheme *sc, op Sc->stack_end[3] = (s7_pointer)Op; \ Sc->stack_end += 4; \ } while (0) + #define push_stack_op(Sc, Op) \ do { \ Sc->stack_end[3] = (s7_pointer)Op; \ Sc->stack_end += 4; \ } while (0) + #define push_stack_op_let(Sc, Op) \ do { \ Sc->stack_end[1] = Sc->envir; \ @@ -6310,7 +6345,7 @@ static void resize_stack(s7_scheme *sc) /* how can we trap infinite recursion? Is a warning in order here? I think I'll add 'max-stack-size */ if (new_size > sc->max_stack_size) - s7_error(sc, s7_make_symbol(sc, "stack-too-big"), set_elist_1(sc, wrap_string(sc, "stack has grown past (*s7* 'max-stack-size)", 43))); + s7_error(sc, make_symbol(sc, "stack-too-big"), set_elist_1(sc, wrap_string(sc, "stack has grown past (*s7* 'max-stack-size)", 43))); ob = stack_block(sc->stack); nb = reallocate(sc, ob, new_size * sizeof(s7_pointer)); @@ -6323,7 +6358,7 @@ static void resize_stack(s7_scheme *sc) #if S7_DEBUGGING abort(); #endif - s7_error(sc, s7_make_symbol(sc, "stack-too-big"), set_elist_1(sc, wrap_string(sc, "no room to expand stack?", 24))); + s7_error(sc, make_symbol(sc, "stack-too-big"), set_elist_1(sc, wrap_string(sc, "no room to expand stack?", 24))); } #if 0 for (i = sc->stack_size; i < new_size; i++) @@ -6402,7 +6437,6 @@ static uint8_t *alloc_symbol(s7_scheme * return(result); } -static inline s7_pointer make_symbol_with_length(s7_scheme *sc, const char *name, s7_int len); static s7_pointer permanent_slot(s7_scheme *sc, s7_pointer symbol, s7_pointer value); static inline s7_pointer new_symbol(s7_scheme *sc, const char *name, s7_int len, uint64_t hash, uint32_t location) @@ -6439,10 +6473,15 @@ static inline s7_pointer new_symbol(s7_s { if ((name[0] == ':') || (name[len - 1] == ':')) { - s7_pointer slot; + s7_pointer slot, ksym; set_type_bit(x, T_IMMUTABLE | T_KEYWORD | T_GLOBAL); - keyword_set_symbol(x, make_symbol_with_length(sc, (name[0] == ':') ? (char *)(name + 1) : name, len - 1)); - set_has_keyword(keyword_symbol(x)); + ksym = make_symbol_with_length(sc, (name[0] == ':') ? (char *)(name + 1) : name, len - 1); + keyword_set_symbol(x, ksym); + set_has_keyword(ksym); + /* the keyword symbol needs to be permanent (not a gensym) else we have to laboriously gc-protect it */ + if ((is_gensym(ksym)) && + (in_heap(ksym))) + s7_remove_from_heap(sc, ksym); slot = permanent_slot(sc, x, x); set_global_slot(x, slot); set_local_slot(x, slot); @@ -6486,13 +6525,11 @@ static inline s7_pointer make_symbol_wit return(new_symbol(sc, name, len, hash, location)); } - static s7_pointer make_symbol(s7_scheme *sc, const char *name) { return(make_symbol_with_length(sc, name, safe_strlen(name))); } - s7_pointer s7_make_symbol(s7_scheme *sc, const char *name) { if (!name) return(sc->F); @@ -6524,7 +6561,6 @@ s7_pointer s7_symbol_table_find_name(s7_ return(result); } - #define FILLED true #define NOT_FILLED false @@ -6744,10 +6780,7 @@ static s7_pointer g_gensym(s7_scheme *sc /* -------------------------------- syntax? -------------------------------- */ -bool s7_is_syntax(s7_pointer p) -{ - return(is_syntax(p)); -} +bool s7_is_syntax(s7_pointer p) {return(is_syntax(p));} static s7_pointer g_is_syntax(s7_scheme *sc, s7_pointer args) { @@ -6758,10 +6791,7 @@ static s7_pointer g_is_syntax(s7_scheme } /* -------------------------------- symbol? -------------------------------- */ -bool s7_is_symbol(s7_pointer p) -{ - return(is_symbol(p)); -} +bool s7_is_symbol(s7_pointer p) {return(is_symbol(p));} static s7_pointer g_is_symbol(s7_scheme *sc, s7_pointer args) { @@ -6771,11 +6801,7 @@ static s7_pointer g_is_symbol(s7_scheme check_boolean_method(sc, is_symbol, sc->is_symbol_symbol, args); } - -const char *s7_symbol_name(s7_pointer p) -{ - return(symbol_name(p)); -} +const char *s7_symbol_name(s7_pointer p) {return(symbol_name(p));} s7_pointer s7_name_to_value(s7_scheme *sc, const char *name) { @@ -7059,7 +7085,6 @@ static s7_pointer old_frame_with_slot(s7 slot_set_value(x, val); sym = slot_symbol(x); symbol_set_local(sym, id, x); - return(env); } @@ -7078,7 +7103,6 @@ static s7_pointer old_frame_with_two_slo slot_set_value(x, val2); sym = slot_symbol(x); symbol_set_local(sym, id, x); - return(env); } @@ -7104,14 +7128,20 @@ static s7_pointer old_frame_with_three_s slot_set_value(x, val3); sym = slot_symbol(x); symbol_set_local(sym, id, x); - return(env); } +#if S7_DEBUGGING +static s7_int permanent_slots = 0; +#endif + static s7_pointer permanent_slot(s7_scheme *sc, s7_pointer symbol, s7_pointer value) { s7_pointer x; x = alloc_pointer(sc); +#if S7_DEBUGGING + permanent_slots++; +#endif set_type(x, T_SLOT | T_UNHEAP); slot_set_symbol(x, symbol); slot_set_value(x, value); @@ -7216,23 +7246,21 @@ static s7_int let_length(s7_scheme *sc, return(-1); /* ?? */ } } - for (i = 0, p = let_slots(e); is_slot(p); i++, p = next_slot(p)); return(i); } static void slot_set_value_with_hook_1(s7_scheme *sc, s7_pointer slot, s7_pointer value) - { - /* (set! (hook-functions *rootlet-redefinition-hook*) (list (lambda (hook) (format *stderr* "~A ~A~%" (hook 'symbol) (hook 'value))))) */ - s7_pointer symbol; - symbol = slot_symbol(slot); - if ((global_slot(symbol) == slot) && - (value != slot_value(slot))) - s7_call(sc, sc->rootlet_redefinition_hook, set_elist_2(sc, symbol, value)); - slot_set_value(slot, value); - } - +{ + /* (set! (hook-functions *rootlet-redefinition-hook*) (list (lambda (hook) (format *stderr* "~A ~A~%" (hook 'symbol) (hook 'value))))) */ + s7_pointer symbol; + symbol = slot_symbol(slot); + if ((global_slot(symbol) == slot) && + (value != slot_value(slot))) + s7_call(sc, sc->rootlet_redefinition_hook, set_elist_2(sc, symbol, value)); + slot_set_value(slot, value); +} static s7_pointer make_slot_1(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_pointer value) { @@ -7382,12 +7410,9 @@ s7_pointer s7_make_slot(s7_scheme *sc, s } return(make_slot_1(sc, env, symbol, value)); - /* there are about the same number of frames as local variables -- this - * strikes me as surprising, but it holds up across a lot of code. - */ + /* there are about the same number of frames as local variables -- this strikes me as surprising, but it holds up across a lot of code. */ } - static s7_pointer make_slot(s7_scheme *sc, s7_pointer variable, s7_pointer value) { /* this is for a do-loop optimization -- an unattached slot */ @@ -7400,10 +7425,7 @@ static s7_pointer make_slot(s7_scheme *s /* -------------------------------- let? -------------------------------- */ -bool s7_is_let(s7_pointer e) -{ - return(is_let(e)); -} +bool s7_is_let(s7_pointer e) {return(is_let(e));} static s7_pointer g_is_let(s7_scheme *sc, s7_pointer args) { @@ -7519,10 +7541,7 @@ static s7_pointer g_unlet(s7_scheme *sc, /* -------------------------------- openlet? -------------------------------- */ -bool s7_is_openlet(s7_pointer e) -{ - return(has_methods(e)); -} +bool s7_is_openlet(s7_pointer e) {return(has_methods(e));} static s7_pointer g_is_openlet(s7_scheme *sc, s7_pointer args) { @@ -8223,7 +8242,7 @@ static s7_pointer let_ref_p_pp(s7_scheme static inline s7_pointer g_lint_let_ref(s7_scheme *sc, s7_pointer args) { s7_pointer lt; - lt = symbol_to_value_unchecked(sc, opt2_sym(args)); /* cadar */ + lt = lookup(sc, opt2_sym(args)); /* cadar */ if (is_pair(lt)) { lt = cdr(lt); @@ -8271,7 +8290,7 @@ static s7_pointer let_ref_chooser(s7_sch static bool op_environment_c(s7_scheme *sc) { s7_pointer s; - s = symbol_to_value_checked(sc, car(sc->code)); + s = lookup_checked(sc, car(sc->code)); if (!is_let(s)) {sc->last_function = s; return(false);} sc->value = s7_let_ref(sc, T_Pos(s), opt3_any(sc->code)); return(true); @@ -8280,9 +8299,9 @@ static bool op_environment_c(s7_scheme * static bool op_environment_a(s7_scheme *sc) { s7_pointer s; - s = symbol_to_value_checked(sc, car(sc->code)); + s = lookup_checked(sc, car(sc->code)); if (!is_let(s)) {sc->last_function = s; return(false);} - sc->value = s7_let_ref(sc, s, c_call(cdr(sc->code))(sc, cadr(sc->code))); + sc->value = s7_let_ref(sc, s, fx_call(sc, cdr(sc->code))); return(true); } @@ -8447,7 +8466,7 @@ static s7_pointer g_lint_let_set_1(s7_sc static s7_pointer g_lint_let_set(s7_scheme *sc, s7_pointer args) { - return(g_lint_let_set_1(sc, symbol_to_value_checked(sc, opt3_sym(args)), opt1_con(args), symbol_to_value_unchecked(sc, opt2_sym(args)))); + return(g_lint_let_set_1(sc, lookup_checked(sc, opt3_sym(args)), opt1_con(args), lookup(sc, opt2_sym(args)))); } static s7_pointer let_set_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) @@ -8553,15 +8572,8 @@ static s7_pointer g_rootlet(s7_scheme *s * so I guess I'll leave it alone. (See curlet|funclet as well). */ -s7_pointer s7_rootlet(s7_scheme *sc) -{ - return(sc->rootlet); -} - -s7_pointer s7_shadow_rootlet(s7_scheme *sc) -{ - return(sc->shadow_rootlet); -} +s7_pointer s7_rootlet(s7_scheme *sc) {return(sc->rootlet);} +s7_pointer s7_shadow_rootlet(s7_scheme *sc) {return(sc->shadow_rootlet);} s7_pointer s7_set_shadow_rootlet(s7_scheme *sc, s7_pointer let) { @@ -8611,10 +8623,7 @@ s7_pointer s7_set_curlet(s7_scheme *sc, /* -------------------------------- outlet -------------------------------- */ -s7_pointer s7_outlet(s7_scheme *sc, s7_pointer e) -{ - return(outlet(e)); -} +s7_pointer s7_outlet(s7_scheme *sc, s7_pointer e) {return(outlet(e));} static s7_pointer g_outlet(s7_scheme *sc, s7_pointer args) { @@ -8672,9 +8681,9 @@ static inline s7_pointer symbol_to_slot( } #if WITH_GCC && S7_DEBUGGING -static s7_pointer symbol_to_value_unchecked_1(s7_scheme *sc, s7_pointer symbol) +static s7_pointer lookup_1(s7_scheme *sc, s7_pointer symbol) #else -static inline s7_pointer symbol_to_value_unchecked(s7_scheme *sc, s7_pointer symbol) /* symbol_to_value_checked includes the unbound_variable call */ +static inline s7_pointer lookup(s7_scheme *sc, s7_pointer symbol) /* lookup_checked includes the unbound_variable call */ #endif { s7_pointer x; @@ -8785,7 +8794,7 @@ s7_pointer s7_symbol_local_value(s7_sche /* -------------------------------- symbol->value -------------------------------- */ -#define find_global_symbol_checked(Sc, Sym) ((is_global(Sym)) ? slot_value(global_slot(Sym)) : symbol_to_value_checked(Sc, Sym)) +#define find_global_symbol_checked(Sc, Sym) ((is_global(Sym)) ? slot_value(global_slot(Sym)) : lookup_checked(Sc, Sym)) static s7_pointer g_s7_let_ref_fallback(s7_scheme *sc, s7_pointer args); @@ -9154,7 +9163,7 @@ static s7_pointer copy_tree(s7_scheme *s static inline bool tree_is_cyclic_1(s7_scheme *sc, s7_pointer tree) { s7_pointer p; - if (car(tree) == sc->quote_symbol) return(false); /* not quite correct (given apply) */ + if (car(tree) == sc->quote_symbol) return(false); /* not quite correct (given apply and circular list readers) */ for (p = tree; is_pair(p); p = cdr(p)) { if (is_tree_collected_or_shared(p)) @@ -9291,14 +9300,10 @@ static s7_pointer g_is_defined(s7_scheme if (b == sc->T) return(sc->F); - return(make_boolean(sc, is_slot(global_slot(sym)))); } - else - { - if (is_global(sym)) - return(sc->T); - } + if (is_global(sym)) + return(sc->T); return(make_boolean(sc, is_slot(symbol_to_slot(sc, sym)))); } @@ -9391,10 +9396,7 @@ s7_pointer s7_define_constant_with_docum /* -------------------------------- keyword? -------------------------------- */ -bool s7_is_keyword(s7_pointer obj) -{ - return(is_keyword(obj)); -} +bool s7_is_keyword(s7_pointer obj) {return(is_keyword(obj));} static s7_pointer g_is_keyword(s7_scheme *sc, s7_pointer args) { @@ -9448,10 +9450,7 @@ static s7_pointer g_keyword_to_symbol(s7 return(keyword_symbol(sym)); } -s7_pointer s7_keyword_to_symbol(s7_scheme *sc, s7_pointer key) -{ - return(keyword_symbol(key)); -} +s7_pointer s7_keyword_to_symbol(s7_scheme *sc, s7_pointer key) {return(keyword_symbol(key));} /* -------------------------------- symbol->keyword -------------------------------- */ @@ -9472,10 +9471,7 @@ static s7_pointer g_symbol_to_keyword(s7 /* -------------------------------- c-pointer? -------------------------------- */ -bool s7_is_c_pointer(s7_pointer arg) -{ - return(is_c_pointer(arg)); -} +bool s7_is_c_pointer(s7_pointer arg) {return(is_c_pointer(arg));} bool s7_is_c_pointer_of_type(s7_pointer arg, s7_pointer type) { @@ -9845,7 +9841,6 @@ static s7_pointer make_baffle(s7_scheme return(x); } - static bool find_baffle(s7_scheme *sc, s7_int key) { /* search backwards through sc->envir for sc->baffle_symbol with key as value */ @@ -10093,10 +10088,10 @@ static bool op_continuation_a(s7_scheme { s7_pointer s, code; code = sc->code; - s = symbol_to_value_checked(sc, car(code)); + s = lookup_checked(sc, car(code)); if (!is_continuation(s)) {sc->last_function = s; return(false);} sc->code = s; - sc->args = set_plist_1(sc, c_call(cdr(code))(sc, cadr(code))); + sc->args = set_plist_1(sc, fx_call(sc, cdr(code))); apply_continuation(sc); return(true); } @@ -10159,9 +10154,7 @@ static void call_with_exit(s7_scheme *sc sc->args = sc->nil; sc->code = dynamic_wind_out(lx); eval(sc, OP_APPLY); - } - } - } + }}} break; case OP_EVAL_STRING: @@ -10292,19 +10285,14 @@ static s7_pointer op_call_with_exit(s7_s static s7_pointer op_call_with_exit_p(s7_scheme *sc) { - s7_pointer go, args; - set_current_code(sc, sc->code); - args = opt2_pair(sc->code); - go = make_goto(sc); - push_stack_no_let_no_code(sc, OP_DEACTIVATE_GOTO, go); - new_frame_with_slot(sc, sc->envir, sc->envir, caar(args), go); - sc->code = cadr(args); + op_call_with_exit(sc); + sc->code = car(sc->code); return(NULL); } static bool op_goto(s7_scheme *sc) { - set_opt1_goto(sc->code, symbol_to_value_checked(sc, car(sc->code))); + set_opt1_goto(sc->code, lookup_checked(sc, car(sc->code))); if (!is_goto(opt1_goto(sc->code))) return(false); sc->args = sc->nil; sc->code = T_Got(opt1_goto(sc->code)); @@ -10314,9 +10302,9 @@ static bool op_goto(s7_scheme *sc) static bool op_goto_a(s7_scheme *sc) { - set_opt1_goto(sc->code, symbol_to_value_checked(sc, car(sc->code))); + set_opt1_goto(sc->code, lookup_checked(sc, car(sc->code))); if (!is_goto(opt1_goto(sc->code))) return(false); - sc->args = list_1(sc, c_call(cdr(sc->code))(sc, cadr(sc->code))); + sc->args = list_1(sc, fx_call(sc, cdr(sc->code))); sc->code = T_Got(opt1_goto(sc->code)); call_with_exit(sc); return(true); @@ -10856,20 +10844,19 @@ s7_pointer s7_make_complex(s7_scheme *sc s7_pointer s7_make_ratio(s7_scheme *sc, s7_int a, s7_int b) { s7_pointer x; - s7_int divisor; if (b == 0) return(division_by_zero_error(sc, wrap_string(sc, "make-ratio", 10), set_elist_2(sc, wrap_integer1(sc, a), small_int(0)))); if (a == 0) return(small_int(0)); + if (a == b) + return(small_int(1)); if (b == 1) return(make_integer(sc, a)); #if (!WITH_GMP) if (b == s7_int_min) { - if (a == b) - return(small_int(1)); /* we've got a problem... This should not trigger an error during reading -- we might have the * ratio on a switch with-bignums or whatever, so its mere occurrence is just an annoyance. */ @@ -10885,11 +10872,31 @@ s7_pointer s7_make_ratio(s7_scheme *sc, a = -a; b = -b; } - divisor = c_gcd(a, b); - if (divisor != 1) + + if (a == s7_int_min) + { + while (((a & 1) == 0) && ((b & 1) == 0)) + { + a /= 2; + b /= 2; + } + } + else { - a /= divisor; - b /= divisor; + s7_int b1, divisor; + divisor = s7_int_abs(a); + b1 = b; + do { + s7_int temp; + temp = divisor % b1; + divisor = b1; + b1 = temp; + } while (b1 != 0); + if (divisor != 1) + { + a /= divisor; + b /= divisor; + } } if (b == 1) return(make_integer(sc, a)); @@ -10897,7 +10904,6 @@ s7_pointer s7_make_ratio(s7_scheme *sc, new_cell(sc, x, T_RATIO); numerator(x) = a; denominator(x) = b; - return(x); } @@ -11118,15 +11124,9 @@ static s7_pointer s7_invert(s7_scheme *s { switch (type(p)) { - case T_INTEGER: - return(make_simple_ratio(sc, 1, integer(p))); /* a already checked, not 0 */ - - case T_RATIO: - return(make_simple_ratio(sc, denominator(p), numerator(p))); - - case T_REAL: - return(make_real(sc, 1.0 / real(p))); - + case T_INTEGER: return(make_simple_ratio(sc, 1, integer(p))); /* a already checked, not 0 */ + case T_RATIO: return(make_simple_ratio(sc, denominator(p), numerator(p))); + case T_REAL: return(make_real(sc, 1.0 / real(p))); case T_COMPLEX: { s7_double r2, i2, den; @@ -11216,7 +11216,7 @@ static bool s7_is_zero(s7_pointer x) static bool s7_is_one(s7_pointer x) { return(((is_integer(x)) && (integer(x) == 1)) || - ((is_t_real(x)) && (real(x) == 1.0))); + ((is_float(x)) && (real(x) == 1.0))); } @@ -11744,6 +11744,24 @@ static s7_pointer number_to_string_p_p(s return(make_string_with_length(sc, res, nlen)); } +static s7_pointer number_to_string_p_i(s7_scheme *sc, s7_int p) +{ + s7_int nlen = 0; + char *res; + res = integer_to_string(sc, p, &nlen); + return(make_string_with_length(sc, res, nlen)); +} + +static s7_pointer number_to_string_p_d(s7_scheme *sc, s7_double x) +{ + s7_int len; + if (!sc->num_to_str) + sc->num_to_str = (char *)malloc(1024 * sizeof(char)); + len = snprintf(sc->num_to_str, sc->num_to_str_size, "%.*g", sc->float_format_precision, x); + floatify(sc->num_to_str, &len); + return(make_string_with_length(sc, sc->num_to_str, len)); +} + static s7_pointer number_to_string_p_pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) { s7_int nlen = 0, radix; @@ -12077,46 +12095,14 @@ static s7_pointer make_sharp_constant(s7 return(chars[(uint8_t)'\n']); break; - case 's': - if (strings_are_equal(name + 1, "space")) - return(chars[(uint8_t)' ']); - break; - - case 'r': - if (strings_are_equal(name + 1, "return")) - return(chars[(uint8_t)'\r']); - break; - - case 'l': - if (strings_are_equal(name + 1, "linefeed")) - return(chars[(uint8_t)'\n']); - break; - - case 't': - if (strings_are_equal(name + 1, "tab")) - return(chars[(uint8_t)'\t']); - break; - - case 'a': - /* the next 4 are for r7rs */ - if (strings_are_equal(name + 1, "alarm")) - return(chars[7]); - break; - - case 'b': - if (strings_are_equal(name + 1, "backspace")) - return(chars[8]); - break; - - case 'e': - if (strings_are_equal(name + 1, "escape")) - return(chars[0x1b]); - break; - - case 'd': - if (strings_are_equal(name + 1, "delete")) - return(chars[0x7f]); - break; + case 's': if (strings_are_equal(name + 1, "space")) return(chars[(uint8_t)' ']); break; + case 'r': if (strings_are_equal(name + 1, "return")) return(chars[(uint8_t)'\r']); break; + case 'l': if (strings_are_equal(name + 1, "linefeed")) return(chars[(uint8_t)'\n']); break; + case 't': if (strings_are_equal(name + 1, "tab")) return(chars[(uint8_t)'\t']); break; + case 'a': if (strings_are_equal(name + 1, "alarm")) return(chars[7]); break; + case 'b': if (strings_are_equal(name + 1, "backspace")) return(chars[8]); break; + case 'e': if (strings_are_equal(name + 1, "escape")) return(chars[0x1b]); break; + case 'd': if (strings_are_equal(name + 1, "delete")) return(chars[0x7f]); break; case 'x': /* #\x is just x, but apparently #\x is int->char? #\x65 -> #\e, and #\xcebb is lambda? */ @@ -12219,7 +12205,7 @@ static s7_int string_to_integer(const ch lval -= 9223372036854775807LL; return(lval - 1); } - else lval = oval; /* old case */ + lval = oval; /* old case */ if ((lval == s7_int_min) && (digits[(uint8_t)(*tmp++)] > 9)) return(lval); *overflow = true; @@ -13315,6 +13301,13 @@ static s7_pointer g_rationalize(s7_schem return(sc->F); /* make compiler happy */ } +s7_pointer rationalize_p_d(s7_scheme *sc, s7_double x) +{ + if ((is_NaN(x)) || (is_inf(x))) + return(out_of_range(sc, sc->rationalize_symbol, small_int(1), make_real(sc, x), a_normal_real_string)); + return(s7_rationalize(sc, x, sc->default_rationalize_error)); +} + /* -------------------------------- angle -------------------------------- */ static s7_pointer g_angle(s7_scheme *sc, s7_pointer args) @@ -13762,6 +13755,7 @@ static s7_pointer g_sin(s7_scheme *sc, s } static s7_double sin_d_d(s7_double x) {return(sin(x));} +static s7_pointer sin_p_d(s7_scheme *sc, s7_double x) {return(make_real(sc, sin(x)));} /* -------------------------------- cos -------------------------------- */ @@ -13797,6 +13791,7 @@ static s7_pointer g_cos(s7_scheme *sc, s } static s7_double cos_d_d(s7_double x) {return(cos(x));} +static s7_pointer cos_p_d(s7_scheme *sc, s7_double x) {return(make_real(sc, cos(x)));} /* -------------------------------- tan -------------------------------- */ @@ -15351,7 +15346,6 @@ static s7_pointer g_round(s7_scheme *sc, static s7_int round_i_i(s7_int i) {return(i);} static s7_int round_i_7d(s7_scheme *sc, s7_double z) - { if (is_NaN(z)) simple_out_of_range(sc, sc->round_symbol, wrap_real(sc, z), its_nan_string); @@ -15582,7 +15576,7 @@ static s7_pointer g_mod_si(s7_scheme *sc s7_pointer x; s7_int y; - x = symbol_to_value_unchecked(sc, car(args)); + x = lookup(sc, car(args)); y = integer(cadr(args)); if (is_integer(x)) @@ -16017,29 +16011,27 @@ static inline s7_pointer add_p_pp(s7_sch { if (is_t_real(x)) return(make_real(sc, real(x) + real(y))); - else + + switch (type(x)) { - switch (type(x)) - { #if HAVE_OVERFLOW_CHECKS - case T_INTEGER: - { - s7_int val; - if (add_overflow(integer(x), integer(y), &val)) - return(make_real(sc, (double)integer(x) + (double)integer(y))); - return(make_integer(sc, val)); - } + case T_INTEGER: + { + s7_int val; + if (add_overflow(integer(x), integer(y), &val)) + return(make_real(sc, (double)integer(x) + (double)integer(y))); + return(make_integer(sc, val)); + } #else - case T_INTEGER: return(make_integer(sc, integer(x) + integer(y))); + case T_INTEGER: return(make_integer(sc, integer(x) + integer(y))); #endif - case T_RATIO: return(add_ratios(sc, x, y)); - case T_REAL: return(make_real(sc, real(x) + real(y))); - case T_COMPLEX: return(make_complex(sc, real_part(x) + real_part(y), imag_part(x) + imag_part(y))); - default: - if (!is_number(x)) - return(add_out_x(sc, x, y)); - return(add_out_y(sc, x, y)); - } + case T_RATIO: return(add_ratios(sc, x, y)); + case T_REAL: return(make_real(sc, real(x) + real(y))); + case T_COMPLEX: return(make_complex(sc, real_part(x) + real_part(y), imag_part(x) + imag_part(y))); + default: + if (!is_number(x)) + return(add_out_x(sc, x, y)); + return(add_out_y(sc, x, y)); } } @@ -16133,11 +16125,7 @@ static s7_pointer g_add_s1(s7_scheme *sc static s7_pointer g_add_cs1(s7_scheme *sc, s7_pointer args) { s7_pointer x; -#if 0 - fprintf(stderr, "%s\n", DISPLAY_80(args)); - fprintf(stderr, " %s\n", DISPLAY_80(sc->cur_code)); -#endif - x = symbol_to_value_unchecked(sc, car(args)); + x = lookup(sc, car(args)); if (is_integer(x)) return(make_integer(sc, integer(x) + 1)); return(g_add_s1_1(sc, x, args)); @@ -16188,7 +16176,7 @@ static s7_pointer g_add_sis(s7_scheme *s } -static s7_pointer g_add_si(s7_scheme *sc, s7_pointer args) {return(g_add_sis(sc, symbol_to_value_unchecked(sc, car(args)), integer(cadr(args))));} +static s7_pointer g_add_si(s7_scheme *sc, s7_pointer args) {return(g_add_sis(sc, lookup(sc, car(args)), integer(cadr(args))));} static s7_pointer g_add_sfs(s7_scheme *sc, s7_pointer x, s7_double y) { @@ -16204,8 +16192,8 @@ static s7_pointer g_add_sfs(s7_scheme *s return(x); } -static s7_pointer g_add_sf(s7_scheme *sc, s7_pointer args) {return(g_add_sfs(sc, symbol_to_value_unchecked(sc, car(args)), real(cadr(args))));} -static s7_pointer g_add_fs(s7_scheme *sc, s7_pointer args) {return(g_add_sfs(sc, symbol_to_value_unchecked(sc, cadr(args)), real(car(args))));} +static s7_pointer g_add_sf(s7_scheme *sc, s7_pointer args) {return(g_add_sfs(sc, lookup(sc, car(args)), real(cadr(args))));} +static s7_pointer g_add_fs(s7_scheme *sc, s7_pointer args) {return(g_add_sfs(sc, lookup(sc, cadr(args)), real(car(args))));} static s7_pointer g_add_f_sf(s7_scheme *sc, s7_pointer args) { @@ -16215,7 +16203,7 @@ static s7_pointer g_add_f_sf(s7_scheme * x = real(car(args)); vargs = cdadr(args); - s = symbol_to_value_unchecked(sc, car(vargs)); + s = lookup(sc, car(vargs)); y = real(cadr(vargs)); if (is_t_real(s)) @@ -16597,29 +16585,26 @@ static inline s7_pointer subtract_p_pp(s { if (is_t_real(x)) return(make_real(sc, real(x) - real(y))); - else + switch (type(x)) { - switch (type(x)) - { #if HAVE_OVERFLOW_CHECKS - case T_INTEGER: - { - s7_int val; - if (subtract_overflow(integer(x), integer(y), &val)) - return(make_real(sc, (double)integer(x) - (double)integer(y))); - return(make_integer(sc, val)); - } + case T_INTEGER: + { + s7_int val; + if (subtract_overflow(integer(x), integer(y), &val)) + return(make_real(sc, (double)integer(x) - (double)integer(y))); + return(make_integer(sc, val)); + } #else - case T_INTEGER: return(make_integer(sc, integer(x) - integer(y))); + case T_INTEGER: return(make_integer(sc, integer(x) - integer(y))); #endif - case T_RATIO: return(g_subtract(sc, set_plist_2(sc, x, y))); - case T_REAL: return(make_real(sc, real(x) - real(y))); - case T_COMPLEX: return(make_complex(sc, real_part(x) - real_part(y), imag_part(x) - imag_part(y))); - default: - if (!is_number(x)) - return(method_or_bust_with_type(sc, x, sc->subtract_symbol, list_2(sc, x, y), a_number_string, 1)); - return(method_or_bust_with_type(sc, y, sc->subtract_symbol, list_2(sc, x, y), a_number_string, 2)); - } + case T_RATIO: return(g_subtract(sc, set_plist_2(sc, x, y))); + case T_REAL: return(make_real(sc, real(x) - real(y))); + case T_COMPLEX: return(make_complex(sc, real_part(x) - real_part(y), imag_part(x) - imag_part(y))); + default: + if (!is_number(x)) + return(method_or_bust_with_type(sc, x, sc->subtract_symbol, list_2(sc, x, y), a_number_string, 1)); + return(method_or_bust_with_type(sc, y, sc->subtract_symbol, list_2(sc, x, y), a_number_string, 2)); } } @@ -16707,7 +16692,7 @@ static s7_pointer minus_c1(s7_scheme *sc static s7_pointer g_subtract_cs1(s7_scheme *sc, s7_pointer args) { s7_pointer x; - x = symbol_to_value_unchecked(sc, car(args)); + x = lookup(sc, car(args)); if (is_integer(x)) return(make_integer(sc, integer(x) - 1)); return(minus_c1(sc, x)); @@ -16723,7 +16708,7 @@ static s7_pointer g_subtract_csn(s7_sche s7_pointer x; s7_int n; - x = symbol_to_value_unchecked(sc, car(args)); + x = lookup(sc, car(args)); n = s7_integer(cadr(args)); if (is_integer(x)) return(make_integer(sc, integer(x) - n)); @@ -16755,7 +16740,7 @@ static s7_pointer g_subtract_sf(s7_schem s7_pointer x; s7_double n; - x = symbol_to_value_unchecked(sc, car(args)); + x = lookup(sc, car(args)); n = real(cadr(args)); switch (type(x)) { @@ -16793,7 +16778,7 @@ static s7_pointer g_subtract_fs(s7_schem s7_pointer x; s7_double n; - x = symbol_to_value_unchecked(sc, cadr(args)); + x = lookup(sc, cadr(args)); n = real(car(args)); switch (type(x)) { @@ -17137,37 +17122,34 @@ static inline s7_pointer multiply_p_pp(s { if (is_t_real(x)) return(make_real(sc, real(x) * real(y))); - else + switch (type(x)) { - switch (type(x)) - { #if HAVE_OVERFLOW_CHECKS - case T_INTEGER: - { - s7_int n; - if (multiply_overflow(integer(x), integer(y), &n)) - return(make_real(sc, ((s7_double)integer(x)) * ((s7_double)integer(y)))); - return(make_integer(sc, n)); - } + case T_INTEGER: + { + s7_int n; + if (multiply_overflow(integer(x), integer(y), &n)) + return(make_real(sc, ((s7_double)integer(x)) * ((s7_double)integer(y)))); + return(make_integer(sc, n)); + } #else - case T_INTEGER: return(make_integer(sc, integer(x) * integer(y))); + case T_INTEGER: return(make_integer(sc, integer(x) * integer(y))); #endif - case T_RATIO: return(g_multiply(sc, list_2(sc, x, y))); - case T_REAL: return(make_real(sc, real(x) * real(y))); - case T_COMPLEX: - { - s7_double r1, r2, i1, i2; - r1 = real_part(x); - r2 = real_part(y); - i1 = imag_part(x); - i2 = imag_part(y); - return(s7_make_complex(sc, r1 * r2 - i1 * i2, r1 * i2 + r2 * i1)); - } - default: - if (!is_number(x)) - return(method_or_bust_with_type(sc, x, sc->multiply_symbol, list_2(sc, x, y), a_number_string, 1)); - return(method_or_bust_with_type(sc, y, sc->multiply_symbol, list_2(sc, x, y), a_number_string, 2)); - } + case T_RATIO: return(g_multiply(sc, list_2(sc, x, y))); + case T_REAL: return(make_real(sc, real(x) * real(y))); + case T_COMPLEX: + { + s7_double r1, r2, i1, i2; + r1 = real_part(x); + r2 = real_part(y); + i1 = imag_part(x); + i2 = imag_part(y); + return(s7_make_complex(sc, r1 * r2 - i1 * i2, r1 * i2 + r2 * i1)); + } + default: + if (!is_number(x)) + return(method_or_bust_with_type(sc, x, sc->multiply_symbol, list_2(sc, x, y), a_number_string, 1)); + return(method_or_bust_with_type(sc, y, sc->multiply_symbol, list_2(sc, x, y), a_number_string, 2)); } } @@ -17281,8 +17263,8 @@ static s7_pointer g_mul_sis(s7_scheme *s return(x); } -static s7_pointer g_multiply_si(s7_scheme *sc, s7_pointer args) {return(g_mul_sis(sc, symbol_to_value_unchecked(sc, car(args)), integer(cadr(args)), args));} -static s7_pointer g_multiply_is(s7_scheme *sc, s7_pointer args) {return(g_mul_sis(sc, symbol_to_value_unchecked(sc, cadr(args)), integer(car(args)), args));} +static s7_pointer g_multiply_si(s7_scheme *sc, s7_pointer args) {return(g_mul_sis(sc, lookup(sc, car(args)), integer(cadr(args)), args));} +static s7_pointer g_multiply_is(s7_scheme *sc, s7_pointer args) {return(g_mul_sis(sc, lookup(sc, cadr(args)), integer(car(args)), args));} static s7_pointer g_mul_sfs(s7_scheme *sc, s7_pointer x, s7_double y) { @@ -17298,8 +17280,8 @@ static s7_pointer g_mul_sfs(s7_scheme *s return(x); } -static s7_pointer g_multiply_fs(s7_scheme *sc, s7_pointer args) {return(g_mul_sfs(sc, symbol_to_value_unchecked(sc, cadr(args)), real(car(args))));} -static s7_pointer g_multiply_sf(s7_scheme *sc, s7_pointer args) {return(g_mul_sfs(sc, symbol_to_value_unchecked(sc, car(args)), real(cadr(args))));} +static s7_pointer g_multiply_fs(s7_scheme *sc, s7_pointer args) {return(g_mul_sfs(sc, lookup(sc, cadr(args)), real(car(args))));} +static s7_pointer g_multiply_sf(s7_scheme *sc, s7_pointer args) {return(g_mul_sfs(sc, lookup(sc, car(args)), real(cadr(args))));} static s7_pointer g_mul_2_ff(s7_scheme *sc, s7_pointer args) {return(make_real(sc, real(car(args)) * real(cadr(args))));} static s7_pointer g_mul_2_ii(s7_scheme *sc, s7_pointer args) @@ -17325,7 +17307,7 @@ static s7_pointer g_mul_2_fx(s7_scheme * static s7_pointer g_sqr_ss(s7_scheme *sc, s7_pointer args) { s7_pointer x; - x = symbol_to_value_unchecked(sc, car(args)); + x = lookup(sc, car(args)); switch (type(x)) { @@ -17714,6 +17696,7 @@ static s7_double divide_d_7dd(s7_scheme } static s7_pointer divide_p_ii(s7_scheme *sc, s7_int x, s7_int y) {return(s7_make_ratio(sc, x, y));} /* make-ratio checks for y==0 */ +static s7_pointer divide_p_i(s7_scheme *sc, s7_int x) {return(s7_make_ratio(sc, 1, x));} /* ---------------------------------------- max/min ---------------------------------------- */ @@ -18291,7 +18274,7 @@ static s7_pointer g_equal_s_ic(s7_scheme s7_int y; s7_pointer val; - val = symbol_to_value_unchecked(sc, car(args)); + val = lookup(sc, car(args)); y = integer(cadr(args)); if (is_integer(val)) return(make_boolean(sc, integer(val) == y)); @@ -18313,7 +18296,7 @@ static s7_pointer g_equal_length_ic(s7_s s7_int ilen; s7_pointer val; - val = symbol_to_value_unchecked(sc, cadar(args)); + val = lookup(sc, cadar(args)); ilen = integer(cadr(args)); switch (type(val)) @@ -19242,7 +19225,7 @@ static s7_pointer g_less_length_ic(s7_sc s7_int ilen; s7_pointer val; - val = symbol_to_value_unchecked(sc, cadar(args)); + val = lookup(sc, cadar(args)); ilen = integer(cadr(args)); switch (type(val)) @@ -20611,7 +20594,11 @@ order here follows gmp, and is the oppos static bool logbit_b_ii(s7_int i1, s7_int i2) { if (i2 < 0) - return(false); /* no b_7ii_t apparently */ + { + /* no b_7ii_t so fallback on cur_sc, etc -- kinda ugly */ + out_of_range(cur_sc, cur_sc->logbit_symbol, small_int(2), make_integer(cur_sc, i1), its_negative_string); + return(false); + } if (i2 >= s7_int_bits) return(i1 < 0); return((((int64_t)(1LL << (int64_t)i2)) & (int64_t)i1) != 0); @@ -21040,6 +21027,13 @@ static s7_pointer integer_to_char_p_p(s7 return(s7_out_of_range_error(sc, "integer->char", 1, x, "it doen't fit in an unsigned byte")); } +static s7_pointer integer_to_char_p_i(s7_scheme *sc, s7_int ind) +{ + if ((ind >= 0) && (ind < NUM_CHARS)) + return(s7_make_character(sc, (uint8_t)ind)); + return(s7_out_of_range_error(sc, "integer->char", 1, make_integer(sc, ind), "it doen't fit in an unsigned byte")); +} + static uint8_t uppers[256], lowers[256]; static void init_uppers(void) @@ -21447,7 +21441,7 @@ static bool char_eq_b_7pp(s7_scheme *sc, static s7_pointer g_char_equal_s_ic(s7_scheme *sc, s7_pointer args) { s7_pointer c; - c = symbol_to_value_unchecked(sc, car(args)); + c = lookup(sc, car(args)); if (c == cadr(args)) return(sc->T); if (s7_is_character(c)) @@ -21808,7 +21802,7 @@ static s7_pointer wrap_string(s7_scheme #if S7_DEBUGGING if ((strcmp(func, "g_substring_to_temp") != 0) && (safe_strlen(str) != len)) - fprintf(stderr, "%s[%d]: %s len is not %ld but %ld\n", func, line, str, len, safe_strlen(str)); + fprintf(stderr, "%s[%d]: %s len is not %" print_s7_int " but %" print_s7_int "\n", func, line, str, len, safe_strlen(str)); #endif return(x); } @@ -21866,11 +21860,18 @@ static char *make_permanent_c_string(s7_ return(x); } +#if S7_DEBUGGING +static s7_int permanent_strings = 0; +#endif + s7_pointer s7_make_permanent_string(s7_scheme *sc, const char *str) { /* for the symbol table which is never GC'd */ s7_pointer x; x = alloc_pointer(sc); +#if S7_DEBUGGING + permanent_strings++; +#endif set_type(x, T_STRING | T_IMMUTABLE | T_UNHEAP); if (str) { @@ -22317,7 +22318,6 @@ static s7_pointer g_string_append(s7_sch return(g_string_append_1(sc, args, sc->string_append_symbol)); } - #if (!WITH_PURE_S7) static s7_pointer g_string_copy(s7_scheme *sc, s7_pointer args) { @@ -22376,7 +22376,6 @@ static s7_pointer start_and_end(s7_schem return(sc->gc_nil); } - static s7_pointer g_substring(s7_scheme *sc, s7_pointer args) { #define H_substring "(substring str start (end (length str))) returns the portion of the string str between start and \ @@ -22404,7 +22403,6 @@ end: (substring \"01234\" 1 2) -> \"1\"" return(x); } - static s7_pointer g_substring_to_temp(s7_scheme *sc, s7_pointer args) { s7_pointer str; @@ -22446,13 +22444,12 @@ static int32_t scheme_strcmp(s7_pointer if (len < sizeof(size_t)) { for (i = 0; i < len; i++) - if ((uint8_t)(str1[i]) < (uint8_t )(str2[i])) - return(-1); - else - { - if ((uint8_t)(str1[i]) > (uint8_t)(str2[i])) - return(1); - } + { + if ((uint8_t)(str1[i]) < (uint8_t )(str2[i])) + return(-1); + if ((uint8_t)(str1[i]) > (uint8_t)(str2[i])) + return(1); + } } else { @@ -22519,7 +22516,6 @@ static s7_pointer g_string_cmp(s7_scheme return(sc->T); } - static s7_pointer g_string_cmp_not(s7_scheme *sc, s7_pointer args, int32_t val, s7_pointer sym) { s7_pointer x, y; @@ -22544,7 +22540,6 @@ static s7_pointer g_string_cmp_not(s7_sc return(sc->T); } - static bool scheme_strings_are_equal(s7_pointer x, s7_pointer y) { return((string_length(x) == string_length(y)) && @@ -22583,7 +22578,6 @@ static s7_pointer g_strings_are_equal(s7 return(sc->T); } - static s7_pointer g_strings_are_less(s7_scheme *sc, s7_pointer args) { #define H_strings_are_less "(stringstring_lt_symbol)); } - static s7_pointer g_strings_are_greater(s7_scheme *sc, s7_pointer args) { #define H_strings_are_greater "(string>? str ...) returns #t if all the string arguments are decreasing" @@ -22601,7 +22594,6 @@ static s7_pointer g_strings_are_greater( return(g_string_cmp(sc, args, 1, sc->string_gt_symbol)); } - static s7_pointer g_strings_are_geq(s7_scheme *sc, s7_pointer args) { #define H_strings_are_geq "(string>=? str ...) returns #t if all the string arguments are equal or decreasing" @@ -22610,7 +22602,6 @@ static s7_pointer g_strings_are_geq(s7_s return(g_string_cmp_not(sc, args, -1, sc->string_geq_symbol)); } - static s7_pointer g_strings_are_leq(s7_scheme *sc, s7_pointer args) { #define H_strings_are_leq "(string<=? str ...) returns #t if all the string arguments are equal or increasing" @@ -22628,7 +22619,6 @@ static s7_pointer g_string_equal_2(s7_sc return(make_boolean(sc, scheme_strings_are_equal(car(args), cadr(args)))); } - static s7_pointer g_string_less_2(s7_scheme *sc, s7_pointer args) { if (!is_string(car(args))) @@ -22638,7 +22628,6 @@ static s7_pointer g_string_less_2(s7_sch return(make_boolean(sc, scheme_strcmp(car(args), cadr(args)) == -1)); } - static s7_pointer g_string_greater_2(s7_scheme *sc, s7_pointer args) { if (!is_string(car(args))) @@ -22711,13 +22700,12 @@ static int32_t scheme_strcasecmp(s7_poin str2 = (uint8_t *)string_value(s2); for (i = 0; i < len; i++) - if (uppers[(int32_t)str1[i]] < uppers[(int32_t)str2[i]]) - return(-1); - else - { - if (uppers[(int32_t)str1[i]] > uppers[(int32_t)str2[i]]) - return(1); - } + { + if (uppers[(int32_t)str1[i]] < uppers[(int32_t)str2[i]]) + return(-1); + if (uppers[(int32_t)str1[i]] > uppers[(int32_t)str2[i]]) + return(1); + } if (len1 < len2) return(-1); @@ -22726,7 +22714,6 @@ static int32_t scheme_strcasecmp(s7_poin return(0); } - static bool scheme_strequal_ci(s7_pointer s1, s7_pointer s2) { /* same as scheme_strcmp -- watch out for unwanted sign! */ @@ -22782,7 +22769,6 @@ static s7_pointer g_string_ci_cmp(s7_sch return(sc->T); } - static s7_pointer g_string_ci_cmp_not(s7_scheme *sc, s7_pointer args, int32_t val, s7_pointer sym) { s7_pointer x, y; @@ -22802,7 +22788,6 @@ static s7_pointer g_string_ci_cmp_not(s7 return(sc->T); } - static s7_pointer g_strings_are_ci_equal(s7_scheme *sc, s7_pointer args) { #define H_strings_are_ci_equal "(string-ci=? str ...) returns #t if all the string arguments are equal, ignoring case" @@ -22810,7 +22795,6 @@ static s7_pointer g_strings_are_ci_equal return(g_string_ci_cmp(sc, args, 0, sc->string_ci_eq_symbol)); } - static s7_pointer g_strings_are_ci_less(s7_scheme *sc, s7_pointer args) { #define H_strings_are_ci_less "(string-cistring_ci_lt_symbol)); } - static s7_pointer g_strings_are_ci_greater(s7_scheme *sc, s7_pointer args) { #define H_strings_are_ci_greater "(string-ci>? str ...) returns #t if all the string arguments are decreasing, ignoring case" @@ -22826,7 +22809,6 @@ static s7_pointer g_strings_are_ci_great return(g_string_ci_cmp(sc, args, 1, sc->string_ci_gt_symbol)); } - static s7_pointer g_strings_are_ci_geq(s7_scheme *sc, s7_pointer args) { #define H_strings_are_ci_geq "(string-ci>=? str ...) returns #t if all the string arguments are equal or decreasing, ignoring case" @@ -22834,7 +22816,6 @@ static s7_pointer g_strings_are_ci_geq(s return(g_string_ci_cmp_not(sc, args, -1, sc->string_ci_geq_symbol)); } - static s7_pointer g_strings_are_ci_leq(s7_scheme *sc, s7_pointer args) { #define H_strings_are_ci_leq "(string-ci<=? str ...) returns #t if all the string arguments are equal or increasing, ignoring case" @@ -22842,7 +22823,6 @@ static s7_pointer g_strings_are_ci_leq(s return(g_string_ci_cmp_not(sc, args, 1, sc->string_ci_leq_symbol)); } - static bool string_ci_lt_b_direct(s7_pointer p1, s7_pointer p2) {return(scheme_strcasecmp(p1, p2) == -1);} static bool string_ci_lt_b_7pp(s7_scheme *sc, s7_pointer p1, s7_pointer p2) { @@ -22877,7 +22857,6 @@ static bool string_ci_eq_b_7pp(s7_scheme check_string2_args(sc, sc->string_ci_eq_symbol, p1, p2); return(scheme_strcasecmp(p1, p2) == 0); } - #endif /* pure s7 */ @@ -23320,7 +23299,6 @@ static s7_pointer g_is_char_ready(s7_sch } return(make_boolean(sc, (is_input_port(sc->input_port)) && (is_string_port(sc->input_port)))); } - #endif /* -------- ports -------- */ @@ -23521,13 +23499,11 @@ static int32_t file_read_char(s7_scheme return(fgetc(port_file(port))); } - static int32_t function_read_char(s7_scheme *sc, s7_pointer port) { return(character((*(port_input_function(port)))(sc, S7_READ_CHAR, port))); } - static int32_t string_read_char(s7_scheme *sc, s7_pointer port) { if (port_data_size(port) <= port_position(port)) /* port_string_length is 0 if no port string */ @@ -23535,14 +23511,12 @@ static int32_t string_read_char(s7_schem return((uint8_t)port_data(port)[port_position(port)++]); } - static int32_t output_read_char(s7_scheme *sc, s7_pointer port) { simple_wrong_type_argument_with_type(sc, sc->read_char_symbol, port, an_input_port_string); return(0); } - static int32_t closed_port_read_char(s7_scheme *sc, s7_pointer port) { simple_wrong_type_argument_with_type(sc, sc->read_char_symbol, port, an_open_port_string); @@ -23557,19 +23531,16 @@ static s7_pointer output_read_line(s7_sc return(simple_wrong_type_argument_with_type(sc, sc->read_line_symbol, port, an_input_port_string)); } - static s7_pointer closed_port_read_line(s7_scheme *sc, s7_pointer port, bool with_eol, bool copied) { return(simple_wrong_type_argument_with_type(sc, sc->read_line_symbol, port, an_open_port_string)); } - static s7_pointer function_read_line(s7_scheme *sc, s7_pointer port, bool with_eol, bool copied) { return((*(port_input_function(port)))(sc, S7_READ_LINE, port)); } - static s7_pointer stdin_read_line(s7_scheme *sc, s7_pointer port, bool with_eol, bool copied) { if (!sc->read_line_buf) @@ -23583,7 +23554,6 @@ static s7_pointer stdin_read_line(s7_sch return(make_string_with_length(sc, NULL, 0)); } - static s7_pointer file_read_line(s7_scheme *sc, s7_pointer port, bool with_eol, bool copied) { char *buf; @@ -23629,7 +23599,6 @@ static s7_pointer file_read_line(s7_sche return(eof_object); } - static s7_pointer string_read_line(s7_scheme *sc, s7_pointer port, bool with_eol, bool copied) { s7_int i, port_start; @@ -23705,7 +23674,6 @@ static void function_write_char(s7_schem (*(port_output_function(port)))(sc, c, port); } - #define PORT_DATA_SIZE 256 static void file_write_char(s7_scheme *sc, uint8_t c, s7_pointer port) { @@ -23718,7 +23686,6 @@ static void file_write_char(s7_scheme *s port_data(port)[port_position(port)++] = c; } - static void input_write_char(s7_scheme *sc, uint8_t c, s7_pointer port) { simple_wrong_type_argument_with_type(sc, sc->write_char_symbol, port, an_output_port_string); @@ -23779,7 +23746,6 @@ static void stderr_write_string(s7_schem } } - static void string_write_string_resized(s7_scheme *sc, const char *str, s7_int len, s7_pointer pt) { s7_int new_len; /* len is known to be non-zero, str may not be 0-terminated */ @@ -23803,7 +23769,6 @@ static void string_write_string(s7_schem else string_write_string_resized(sc, str, len, pt); } - static void file_write_string(s7_scheme *sc, const char *str, s7_int len, s7_pointer pt) { s7_int new_len; @@ -23864,7 +23829,6 @@ static void function_write_string(s7_sch (*(port_output_function(pt)))(sc, str[i], pt); } - static void stdout_display(s7_scheme *sc, const char *s, s7_pointer port) { if (s) fputs(s, stdout); @@ -23988,7 +23952,6 @@ static void resize_strbuf(s7_scheme *sc, for (i = old_size; i < sc->strbuf_size; i++) sc->strbuf[i] = '\0'; } - static s7_pointer file_read_name_or_sharp(s7_scheme *sc, s7_pointer pt, bool atom_case) { int32_t c; @@ -24195,7 +24158,7 @@ static block_t *mallocate_port(s7_scheme block_next(p) = NULL; } else - { + { /* this is mallocate without the index calc */ p = mallocate_block(sc); block_data(p) = (void *)alloc_permanent_string(sc, (size_t)(1 << PORT_LIST)); block_set_index(p, PORT_LIST); @@ -24223,9 +24186,7 @@ static s7_pointer read_file(s7_scheme *s port_write_character(port) = input_write_char; port_write_string(port) = input_write_string; - /* if we're constantly opening files, and each open saves the file name in permanent - * memory, we gradually core-up. - */ + /* if we're constantly opening files, and each open saves the file name in permanent memory, we gradually core-up. */ port_filename_length(port) = safe_strlen(name); port_set_filename(sc, port, name, port_filename_length(port)); port_line_number(port) = 1; /* first line is numbered 1 */ @@ -24376,7 +24337,6 @@ static bool is_directory(const char *fil return(false); } - static s7_pointer open_input_file_1(s7_scheme *sc, const char *name, const char *mode, const char *caller) { FILE *fp; @@ -24422,7 +24382,6 @@ static s7_pointer open_input_file_1(s7_s return(make_input_file(sc, name, fp)); } - s7_pointer s7_open_input_file(s7_scheme *sc, const char *name, const char *mode) { return(open_input_file_1(sc, name, mode, "open-input-file")); @@ -24452,12 +24411,19 @@ static s7_pointer g_open_input_file(s7_s return(open_input_file_1(sc, string_value(name), "r", "open-input-file")); } +#if S7_DEBUGGING +static s7_int permanent_ports = 0; +#endif + static void make_standard_ports(s7_scheme *sc) { s7_pointer x; /* standard output */ x = alloc_pointer(sc); +#if S7_DEBUGGING + permanent_ports += 3; +#endif set_type(x, T_OUTPUT_PORT | T_IMMUTABLE | T_UNHEAP); port_port(x) = (port_t *)calloc(1, sizeof(port_t)); port_type(x) = FILE_PORT; @@ -25528,7 +25494,7 @@ defaults to the rootlet. To load into t { s7_pointer init; - init = s7_let_ref(sc, (is_null(sc->envir)) ? sc->rootlet : sc->envir, s7_make_symbol(sc, "init_func")); + init = s7_let_ref(sc, (is_null(sc->envir)) ? sc->rootlet : sc->envir, make_symbol(sc, "init_func")); if (is_symbol(init)) { void *library; @@ -25555,11 +25521,8 @@ defaults to the rootlet. To load into t if (pname) liberate(sc, pname); return(sc->T); } - else - { - s7_warn(sc, 512, "loaded %s, but can't find %s (%s)?\n", fname, init_name, dlerror()); - dlclose(library); - } + s7_warn(sc, 512, "loaded %s, but can't find %s (%s)?\n", fname, init_name, dlerror()); + dlclose(library); } else s7_warn(sc, 512, "load %s failed: %s\n", (pname) ? pwd_name : fname, dlerror()); if (pname) liberate(sc, pname); @@ -25944,7 +25907,7 @@ static s7_pointer g_is_provided(s7_schem bool s7_is_provided(s7_scheme *sc, const char *feature) { - return(is_memq(s7_make_symbol(sc, feature), s7_symbol_value(sc, sc->features_symbol))); /* this goes from local outward */ + return(is_memq(make_symbol(sc, feature), s7_symbol_value(sc, sc->features_symbol))); /* this goes from local outward */ } static bool is_provided_b_7p(s7_scheme *sc, s7_pointer sym) @@ -26064,6 +26027,7 @@ static s7_pointer g_eval_string(s7_schem push_stack_op_let(sc, OP_READ_INTERNAL); return(sc->F); + /* I think this means that sc->value defaults to #f in op_eval_string below, so (eval-string "") mimics (eval) -> #f */ } static s7_pointer eval_string_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) @@ -26719,7 +26683,7 @@ bool s7_iterator_is_at_end(s7_scheme *sc static bool op_iterate(s7_scheme *sc) { s7_pointer s; - s = symbol_to_value_checked(sc, car(sc->code)); + s = lookup_checked(sc, car(sc->code)); if (!is_iterator(s)) {sc->last_function = s; return(false);} sc->value = (iterator_next(s))(sc, s); return(true); @@ -27278,7 +27242,7 @@ static s7_pointer cyclic_sequences(s7_sc sc->w = sc->nil; return(lst); } - else return(sc->T); + return(sc->T); } } return(sc->nil); @@ -28639,18 +28603,13 @@ static void hash_table_to_port(s7_scheme (is_cyclic(hash)) && (peek_shared_ref(ci, hash) != 0)) { - /* TODO: eq-func if user-set */ - /* (let ((<1> (make-hash-table morally-equal?))) - * and then fill all fields in cycle_port - * hash_table_checker_locked? - * also weak hash (let ((h (make-weak-hash-table))) then (set! (h key) val)? - */ - int32_t href; href = peek_shared_ref(ci, hash); if (href < 0) href = -href; - - port_write_string(port)(sc, "(hash-table*", 12, port); /* top level let */ + + if (is_weak_hash_table(hash)) + port_write_string(port)(sc, "(weak-hash-table", 16, port); + else port_write_string(port)(sc, "(hash-table", 11, port); /* top level let */ for (i = 0; i < len; i++) { s7_pointer key_val, key, val; @@ -28701,7 +28660,9 @@ static void hash_table_to_port(s7_scheme } else { - port_write_string(port)(sc, "(hash-table*", 12, port); + if (is_weak_hash_table(hash)) + port_write_string(port)(sc, "(weak-hash-table", 16, port); + else port_write_string(port)(sc, "(hash-table", 11, port); for (i = 0; i < len; i++) { s7_pointer key_val; @@ -28729,7 +28690,7 @@ static void hash_table_to_port(s7_scheme s7_gc_unprotect_at(sc, gc_iter); iterator_current(iterator) = sc->nil; free_cell(sc, p); - free_cell(sc, iterator); + /* free_cell(sc, iterator); */ /* 18-Dec-18 removed */ } static int32_t slot_to_port_1(s7_scheme *sc, s7_pointer x, s7_pointer port, use_write_t use_write, shared_info *ci, int32_t n) @@ -29199,7 +29160,7 @@ static void write_closure_readably(s7_sc { if (tree_is_cyclic(sc, body)) s7_error(sc, sc->wrong_type_arg_symbol, wrap_string(sc, "write_closure: body is cyclic", 29)); - /* TODO: if any sequence in the closure_body is cyclic, complain, but how to check without clobbering ci? + /* perhaps: if any sequence in the closure_body is cyclic, complain, but how to check without clobbering ci? * perhaps pass ci, and use make_shared_info if ci=null else continue_shared_info? * this can happen only if (apply lambda ... cyclic-seq ...) I think * long-term we need to include closure_body(obj) in the top object_out make_shared_info @@ -29324,7 +29285,7 @@ static char *describe_type_bits(s7_schem full_typ = typeflag(obj); /* if debugging all of these bits are being watched, so we need to access them directly */ - snprintf(buf, 1024, "type: %d (%s), opt_op: %d, flags: #x%" PRIx64 "%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s", + snprintf(buf, 1024, "type: %d (%s), opt_op: %d, flags: #x%" PRIx64 "%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s", typ, type_name(sc, obj, NO_ARTICLE), optimize_op(obj), @@ -29456,6 +29417,8 @@ static char *describe_type_bits(s7_schem ((is_hash_table(obj)) ? " simple-keys" : ((is_pair(obj)) ? " ctr3-set" : " 32?"))) : "", + /* bit 33+16 */ + ((full_typ & T_FULL_CASE_KEY) != 0) ? " case-key" : "", ((full_typ & UNUSED_BITS) != 0) ? " unused bits set?" : "", @@ -29491,6 +29454,7 @@ static bool has_odd_bits(s7_pointer obj) if (((full_typ & T_UNSAFE) != 0) && (!is_symbol(obj)) && (!is_slot(obj)) && (!is_pair(obj))) return(true); if (((full_typ & T_VERY_SAFE_CLOSURE) != 0) && (!is_pair(obj)) && (!is_any_closure(obj))) return(true); if (((full_typ & T_FULL_SIMPLE_ELEMENTS) != 0) && ((!is_normal_vector(obj)) && (!is_hash_table(obj)) && (!is_pair(obj)))) return(true); + if (((full_typ & T_FULL_CASE_KEY) != 0) && (!is_symbol(obj))) return(true); if (((full_typ & T_FULL_S7_LET_FIELD) != 0) && (!is_symbol(obj)) && (!is_let(obj)) && (!is_pair(obj)) && (!is_any_vector(obj)) && (!is_hash_table(obj)) && (!is_c_function(obj))) return(true); @@ -29613,6 +29577,7 @@ static s7_pointer check_ref(s7_pointer p UNBOLD_TEXT); if ((typ != T_FREE) && (is_syntactic_pair(p)) && (optimize_op(p) == 0)) fprintf(stderr, "syn 0: %s[%d]\n", func, line); + if (stop_at_error) abort(); } else { @@ -29801,12 +29766,19 @@ static void print_gc_info(s7_pointer obj fprintf(stderr, "[%d]: %p type is %d?\n", line, obj, unchecked_type(obj)); else { - fprintf(stderr, "%s%p is free (line %d), current: %s[%d], previous: %s[%d]%s\n", + s7_int free_type; + char *bits; + free_type = typeflag(obj); + typeflag(obj) = obj->current_alloc_type; + bits = describe_type_bits(cur_sc, obj); /* this func called in type macro, so use cur_sc */ + typeflag(obj) = free_type; + fprintf(stderr, "%s%p is free (line %d, alloc type: [%s]), current: %s[%d], previous: %s[%d]%s\n", BOLD_TEXT, - obj, line, + obj, line, bits, obj->current_alloc_func, obj->current_alloc_line, obj->previous_alloc_func, obj->previous_alloc_line, UNBOLD_TEXT); + free(bits); } } abort(); @@ -29897,12 +29869,14 @@ static void show_opt1_bits(s7_pointer p, { char *bits; bits = show_debugger_bits(p->debugger_bits); - fprintf(stderr, "%s%s[%d]: opt1: %p->%p wants %s, debugger bits are %" PRIx64 "%s but expects %x%s\n", + fprintf(stderr, "%s%s[%d]: opt1: %p->%p wants %s, debugger bits are %" PRIx64 "%s but expects %x", BOLD_TEXT, func, line, p, p->object.cons.opt1, opt1_role_name(role), - p->debugger_bits, bits, role, - UNBOLD_TEXT); + p->debugger_bits, bits, role); + if (p->opt1_func) + fprintf(stderr, " (set %s[%d])%s\n", p->opt1_func, p->opt1_line, UNBOLD_TEXT); + else fprintf(stderr, " (unset)%s\n", UNBOLD_TEXT); free(bits); } @@ -29918,11 +29892,18 @@ static s7_pointer opt1_1(s7_pointer p, u return(p->object.cons.opt1); } -static s7_pointer set_opt1_1(s7_pointer p, s7_pointer x, uint32_t role, const char *func, int32_t line) +static void base_opt1(s7_pointer p, uint32_t role, const char *func, int32_t line) { - p->object.cons.opt1 = x; + p->opt1_line = line; + p->opt1_func = func; set_opt1_role(p, role); set_opt1_is_set(p); +} + +static s7_pointer set_opt1_1(s7_pointer p, s7_pointer x, uint32_t role, const char *func, int32_t line) +{ + p->object.cons.opt1 = x; + base_opt1(p, role, func, line); return(x); } @@ -29940,15 +29921,14 @@ static uint64_t s_hash_1(s7_pointer p, c static void set_s_hash_1(s7_pointer p, uint64_t x, const char *func, int32_t line) { p->object.sym_cons.hash = x; - set_opt1_role(p, S_HASH); - set_opt1_is_set(p); + base_opt1(p, S_HASH, func, line); } static void show_opt2_bits(s7_pointer p, const char *func, int32_t line, uint32_t role) { char *bits; bits = show_debugger_bits(p->debugger_bits); - fprintf(stderr, "%s%s[%d]: opt2: %p->%p wants %s, debugger bits are %" PRIx64 "%s but expects %x%s%s%s%s%s%s%s%s%s%s\n", + fprintf(stderr, "%s%s[%d]: opt2: %p->%p wants %s, debugger bits are %" PRIx64 "%s but expects %x%s%s%s%s%s%s%s%s%s", BOLD_TEXT, func, line, p, p->object.cons.opt2, opt2_role_name(role), @@ -29961,11 +29941,23 @@ static void show_opt2_bits(s7_pointer p, ((role & F_CON) != 0) ? " con" : "", ((role & F_CALL) != 0) ? " call" : "", ((role & F_LAMBDA) != 0) ? " lambda" : "", - ((role & S_NAME) != 0) ? " raw-name" : "", - UNBOLD_TEXT); + ((role & S_NAME) != 0) ? " raw-name" : ""); + if (p->opt2_func) + fprintf(stderr, " (set %s[%d])%s\n", p->opt2_func, p->opt2_line, UNBOLD_TEXT); + else fprintf(stderr, " (unset)%s\n", UNBOLD_TEXT); free(bits); } +static bool f_call_func_mismatch(const char *func) +{ + return((!safe_strcmp(func, "check_and")) && /* these reflect set_c_call_checked|unchecked where the destination checks for null c_call */ + (!safe_strcmp(func, "check_or")) && + (!safe_strcmp(func, "eval")) && + (!safe_strcmp(func, "optimize_func_two_args")) && + (!safe_strcmp(func, "optimize_func_many_args")) && + (!safe_strcmp(func, "optimize_func_three_args"))); +} + static s7_pointer opt2_1(s7_scheme *sc, s7_pointer p, uint32_t role, const char *func, int32_t line) { if ((!opt2_is_set(p)) || @@ -29975,25 +29967,31 @@ static s7_pointer opt2_1(s7_scheme *sc, fprintf(stderr, "p: %s\n", string_value(s7_object_to_string(sc, p, false))); if (stop_at_error) abort(); } + if ((role == F_CALL) && + (!has_fx(p)) && + (f_call_func_mismatch(func))) + fprintf(stderr, "%s[%d]: f_call but no fx\n", func, line); return(p->object.cons.opt2); } +static void base_opt2(s7_pointer p, uint32_t role, const char *func, int32_t line) +{ + p->opt2_line = line; + p->opt2_func = func; + set_opt2_role(p, role); + set_opt2_is_set(p); +} + static void set_opt2_1(s7_scheme *sc, s7_pointer p, s7_pointer x, uint32_t role, const char *func, int32_t line) { if ((role == F_CALL) && - (x == NULL)) /* this happens apparently innocuously in check_and|or */ - { - if ((safe_strcmp(func, "check_and") != 0) && - (safe_strcmp(func, "check_or") != 0)) - fprintf(stderr, "%s[%d]: set c_call for %s to null\n", func, line, string_value(object_to_truncated_string(sc, p, 80))); - } - if ((role != F_CALL) && - (opt2_role_matches(p, F_CALL)) && - (has_fx(p))) - fprintf(stderr, "%s[%d]: %s clobbers fx, p: %s\n", func, line, opt2_role_name(role), string_value(s7_object_to_string(sc, p, false))); + (x == NULL) && + (f_call_func_mismatch(func))) + fprintf(stderr, "%s[%d]: set c_call for %s to null\n", func, line, string_value(object_to_truncated_string(sc, p, 80))); + if (role != F_CALL) + clear_has_fx(p); p->object.cons.opt2 = x; - set_opt2_role(p, role); - set_opt2_is_set(p); + base_opt2(p, role, func, line); } static const char *s_name_1(s7_pointer p, const char *func, int32_t line) @@ -30010,18 +30008,17 @@ static const char *s_name_1(s7_pointer p static void set_s_name_1(s7_pointer p, const char *str, const char *func, int32_t line) { p->object.sym_cons.fstr = str; - set_opt2_role(p, S_NAME); - set_opt2_is_set(p); + base_opt2(p, S_NAME, func, line); } static void show_opt3_bits(s7_pointer p, const char *func, int32_t line, int32_t role) { char *bits; bits = show_debugger_bits(p->debugger_bits); - fprintf(stderr, "%s%s[%d]: opt3: %s %" PRIx64 "%s%s\n", - BOLD_TEXT, - func, line, opt3_role_name(role), p->debugger_bits, bits, - UNBOLD_TEXT); + fprintf(stderr, "%s%s[%d]: opt3: %s %" PRIx64 "%s", BOLD_TEXT, func, line, opt3_role_name(role), p->debugger_bits, bits); + if (p->opt3_func) + fprintf(stderr, " (set %s[%d])%s\n", p->opt3_func, p->opt3_line, UNBOLD_TEXT); + else fprintf(stderr, " (unset)%s\n", UNBOLD_TEXT); free(bits); } @@ -30036,12 +30033,19 @@ static s7_pointer opt3_1(s7_pointer p, u return(p->object.cons.opt3); } +static void base_opt3(s7_pointer p, uint32_t role, const char *func, int32_t line) +{ + p->opt3_line = line; + p->opt3_func = func; + set_opt3_role(p, role); + set_opt3_is_set(p); +} + static void set_opt3_1(s7_pointer p, s7_pointer x, uint32_t role, const char *func, int32_t line) { clear_type_bit(p, T_LINE_NUMBER); p->object.cons.opt3 = x; - set_opt3_is_set(p); - set_opt3_role(p, role); + base_opt3(p, role, func, line); } static uint8_t opt3_con_1(s7_pointer p, uint32_t role, const char *func, int32_t line) @@ -30059,8 +30063,7 @@ static void set_opt3_con_1(s7_pointer p, { clear_type_bit(p, T_LINE_NUMBER); p->object.cons_ext.ce.opt_type = x; - set_opt3_is_set(p); - set_opt3_role(p, role); + base_opt3(p, role, func, line); } static int32_t opt3_ctr_1(s7_pointer p, int32_t role, const char *func, int32_t line) @@ -30078,8 +30081,7 @@ static void set_opt3_ctr_1(s7_pointer p, { p->object.cons_ext.ce.ctr = x; set_ctr3_is_set(p); - set_opt3_is_set(p); - set_opt3_role(p, role); + base_opt3(p, role, func, line); } static void increment_opt3_ctr_1(s7_pointer p, uint32_t role, const char *func, int32_t line) @@ -30088,8 +30090,7 @@ static void increment_opt3_ctr_1(s7_poin p->object.cons_ext.ce.ctr++; else p->object.cons_ext.ce.ctr = 0; set_ctr3_is_set(p); - set_opt3_is_set(p); - set_opt3_role(p, role); + base_opt3(p, role, func, line); } /* S_LINE */ @@ -30585,7 +30586,7 @@ static void c_function_to_port(s7_scheme if (use_write == P_READABLE) { s7_pointer sym; - sym = s7_make_symbol(sc, c_function_name(obj)); + sym = make_symbol(sc, c_function_name(obj)); if ((is_slot(initial_slot(sym))) && (!is_global(sym))) { port_write_string(port)(sc, "#_", 2, port); @@ -31003,6 +31004,9 @@ static s7_pointer open_format_port(s7_sc len = FORMAT_PORT_LENGTH; x = alloc_pointer(sc); +#if S7_DEBUGGING + permanent_ports++; +#endif set_type(x, T_OUTPUT_PORT); b = mallocate_port(sc); port_block(x) = b; @@ -31106,8 +31110,8 @@ static s7_pointer g_object_to_string(s7_ if (arg == sc->F) choice = P_DISPLAY; else {if (arg == sc->T) choice = P_WRITE; else {if (arg == sc->key_readable_symbol) choice = P_READABLE; - else {if (arg == s7_make_keyword(sc, "display")) choice = P_DISPLAY; - else {if (arg == s7_make_keyword(sc, "write")) choice = P_WRITE; + else {if (arg == sc->key_display_symbol) choice = P_DISPLAY; + else {if (arg == sc->key_write_symbol) choice = P_WRITE; else return(wrong_type_argument_with_type(sc, sc->object_to_string_symbol, 2, arg, wrap_string(sc, "a boolean or :readable", 22)));}}}} @@ -31841,6 +31845,10 @@ static s7_pointer format_to_port_1(s7_sc if (is_null(fdat->args)) format_error(sc, "missing argument", 16, str, args, fdat); + if ((is_pair(car(fdat->args))) && /* any sequence is possible here */ + (s7_list_length(sc, car(fdat->args)) < 0)) /* (format #f "~{~a~e~}" (cons 1 2)) */ + format_error(sc, "~{ argument is a dotted list", 28, str, args, fdat); + curly_len = format_nesting(str, '{', '}', i, str_len - 1); if (curly_len == -1) @@ -31856,14 +31864,11 @@ static s7_pointer format_to_port_1(s7_sc { s7_pointer curly_arg; /* perhaps use an iterator here -- rootlet->list is expensive! */ - curly_arg = object_to_list(sc, car(fdat->args)); /* if a pair, this simply returns the original */ - if (is_not_null(curly_arg)) /* (format #f "~{~A ~}" #()) -> "" */ + curly_arg = object_to_list(sc, car(fdat->args)); /* if a pair (or non-sequence), this simply returns the original */ + if (is_pair(curly_arg)) /* (format #f "~{~A ~}" #()) -> "" */ { char *curly_str = NULL; /* this is the local (nested) format control string */ - s7_pointer orig_arg; - - if (!s7_is_proper_list(sc, curly_arg)) - format_error(sc, "'{' directive argument should be a proper list or something we can turn into a list", 83, str, args, fdat); + s7_pointer orig_arg, cycle_arg; fdat->curly_arg = curly_arg; if (curly_arg != car(fdat->args)) @@ -31872,7 +31877,7 @@ static s7_pointer format_to_port_1(s7_sc if (curly_len > fdat->curly_len) { - if (fdat->curly_str) free (fdat->curly_str); + if (fdat->curly_str) free(fdat->curly_str); fdat->curly_len = curly_len; fdat->curly_str = (char *)malloc(curly_len * sizeof(char)); } @@ -31888,19 +31893,26 @@ static s7_pointer format_to_port_1(s7_sc * because the curly brackets may enclose multiple arguments -- we would need to use * iterators throughout this function. */ - while (is_not_null(curly_arg)) + cycle_arg = curly_arg; + while (is_pair(curly_arg)) { s7_pointer new_arg = sc->nil; format_to_port_1(sc, port, curly_str, curly_arg, &new_arg, false, columnized, curly_len - 1, NULL); if (curly_arg == new_arg) { + if (cdr(curly_arg) == curly_arg) break; fdat->curly_arg = sc->nil; format_error(sc, "'{...}' doesn't consume any arguments!", 38, str, args, fdat); } curly_arg = new_arg; + if ((!is_pair(curly_arg)) || (curly_arg == cycle_arg)) + break; + cycle_arg = cdr(cycle_arg); + format_to_port_1(sc, port, curly_str, curly_arg, &new_arg, false, columnized, curly_len - 1, NULL); + curly_arg = new_arg; } fdat->curly_arg = sc->nil; - while (is_pair(orig_arg)) + while (is_pair(orig_arg)) /* free_cell below clears the type, so a circular list here is ok */ { s7_pointer p; p = orig_arg; @@ -31908,6 +31920,11 @@ static s7_pointer format_to_port_1(s7_sc free_cell(sc, p); /* if car(fdar->args) is a hash-table, we could also free_cell(car(p)), but not in any other case */ } } + else + { + if (!is_null(curly_arg)) + format_error(sc, "'{' directive argument should be a list or something we can turn into a list", 76, str, args, fdat); + } } i += (curly_len + 2); /* jump past the ending '}' too */ @@ -32492,7 +32509,7 @@ system captures the output as a string a block_set_index(b, TOP_BLOCK_LIST); return(block_to_string(sc, b, cur_len)); } - else return(make_empty_string(sc, 0, 0)); + return(make_empty_string(sc, 0, 0)); #else { s7_pointer res; @@ -32591,11 +32608,17 @@ static s7_pointer cons_unchecked_with_ty return(x); } +#if S7_DEBUGGING +static s7_int permanent_conses = 0; +#endif static s7_pointer permanent_cons(s7_scheme *sc, s7_pointer a, s7_pointer b, uint64_t type) { s7_pointer x; x = alloc_pointer(sc); +#if S7_DEBUGGING + permanent_conses++; +#endif set_type(x, type | T_UNHEAP); set_car(x, a); set_cdr(x, b); @@ -33279,7 +33302,6 @@ static s7_pointer print_truncate(s7_sche return(code); } - s7_pointer s7_assoc(s7_scheme *sc, s7_pointer sym, s7_pointer lst) { s7_pointer x, y; @@ -33305,7 +33327,6 @@ s7_pointer s7_assoc(s7_scheme *sc, s7_po return(sc->F); } - s7_pointer s7_reverse(s7_scheme *sc, s7_pointer a) { /* reverse list -- produce new list (other code assumes this function does not return the original!) */ @@ -33345,7 +33366,6 @@ s7_pointer s7_reverse(s7_scheme *sc, s7_ * (let ((lst (list 0))) (set! (cdr lst) lst) (reverse lst)) -> (#1=(0 . #1#) 0 0 0) */ - static s7_pointer reverse_in_place(s7_scheme *sc, s7_pointer term, s7_pointer list) { s7_pointer p, result; @@ -33373,7 +33393,6 @@ static s7_pointer reverse_in_place(s7_sc return(result); } - static s7_pointer reverse_in_place_unchecked(s7_scheme *sc, s7_pointer term, s7_pointer list) { s7_pointer p = list, result = term; @@ -33405,7 +33424,6 @@ s7_pointer s7_append(s7_scheme *sc, s7_p return(tp); } - static s7_pointer copy_list(s7_scheme *sc, s7_pointer lst) { s7_pointer p, tp, np; @@ -33420,7 +33438,6 @@ static s7_pointer copy_list(s7_scheme *s return(tp); } - static s7_pointer copy_list_with_arglist_error(s7_scheme *sc, s7_pointer lst) { s7_pointer p, tp, np; @@ -33556,7 +33573,6 @@ static s7_pointer g_is_list(s7_scheme *s check_boolean_method(sc, is_a_list, sc->is_list_symbol, args); } - static s7_pointer g_is_proper_list(s7_scheme *sc, s7_pointer args) { #define H_is_proper_list "(proper-list? x) returns #t is x is a list that is neither circular nor dotted." @@ -33635,7 +33651,6 @@ static s7_pointer protected_make_list(s7 return(lst); } - static s7_pointer g_make_list(s7_scheme *sc, s7_pointer args) { #define H_make_list "(make-list length (initial-element #f)) returns a list of 'length' elements whose value is 'initial-element'." @@ -33699,7 +33714,6 @@ static s7_pointer g_list_ref(s7_scheme * #define Q_list_ref s7_make_circular_signature(sc, 2, 3, sc->T, sc->is_pair_symbol, sc->is_integer_symbol) /* (let ((L '((1 2 3) (4 5 6)))) (list-ref L 1 2)) - (define (lref L . args) (if (null? (cdr args)) (list-ref L (car args)) @@ -33726,9 +33740,9 @@ static s7_pointer g_list_ref(s7_scheme * static bool op_pair_a(s7_scheme *sc) { s7_pointer s, x; - s = symbol_to_value_checked(sc, car(sc->code)); + s = lookup_checked(sc, car(sc->code)); if (!is_pair(s)) {sc->last_function = s; return(false);} - x = c_call(cdr(sc->code))(sc, cadr(sc->code)); + x = fx_call(sc, cdr(sc->code)); sc->value = list_ref_1(sc, s, x); return(true); } @@ -33897,7 +33911,6 @@ static s7_pointer g_list_tail(s7_scheme static s7_pointer g_cons(s7_scheme *sc, s7_pointer args) { /* n-ary cons could be the equivalent of CL's list*? */ - /* it would be neater to have a single cons cell able to contain (directly) any number of elements */ /* (set! (cadr (cons 1 2 3)) 4) -> (1 4 . 3) */ #define H_cons "(cons a b) returns a pair containing a and b" @@ -34170,6 +34183,15 @@ static s7_pointer g_caddr(s7_scheme *sc, return(caddr(lst)); } +static s7_pointer caddr_p_p(s7_scheme *sc, s7_pointer p) +{ + if ((is_pair(p)) && + (is_pair(cdr(p))) && + (is_pair(cddr(p)))) + return(caddr(p)); + return(simple_wrong_type_argument(sc, sc->caddr_symbol, p, T_PAIR)); +} + /* -------- cdddr -------- */ static s7_pointer g_cdddr(s7_scheme *sc, s7_pointer args) { @@ -34529,7 +34551,7 @@ static s7_pointer g_assv(s7_scheme *sc, static s7_pointer fx_c_ss(s7_scheme *sc, s7_pointer arg); -static s7_pointer fx_c_c(s7_scheme *sc, s7_pointer arg); +static s7_pointer fx_c_d(s7_scheme *sc, s7_pointer arg); static s7_pointer g_is_eq(s7_scheme *sc, s7_pointer args); static s7_pointer g_is_eqv(s7_scheme *sc, s7_pointer args); static s7_function s7_bool_optimize(s7_scheme *sc, s7_pointer expr); @@ -34781,13 +34803,9 @@ static s7_pointer g_memq(s7_scheme *sc, return(method_or_bust_with_type(sc, y, sc->memq_symbol, list_2(sc, x, y), a_list_string, 2)); } -/* I think (memq 'c '(a b . c)) should return #f because otherwise - * (memq () ...) would return the () at the end. - */ +/* I think (memq 'c '(a b . c)) should return #f because otherwise (memq () ...) would return the () at the end. */ +/* if memq's list is a quoted list, it won't be changing, so we can tell ahead of time that it is a proper list, and what its length is. */ -/* if memq's list is a quoted list, it won't be changing, so we can tell ahead of time that it is - * a proper list, and what its length is. - */ static s7_pointer g_memq_2(s7_scheme *sc, s7_pointer args) { s7_pointer x, obj; @@ -34846,7 +34864,7 @@ static s7_pointer g_memq_car(s7_scheme * { s7_pointer x, obj; - obj = symbol_to_value_unchecked(sc, opt2_sym(args)); + obj = lookup(sc, opt2_sym(args)); if (is_pair(obj)) obj = car(obj); else obj = g_car(sc, set_plist_1(sc, obj)); @@ -34863,7 +34881,7 @@ static s7_pointer g_memq_car_2(s7_scheme { s7_pointer x, obj; - obj = symbol_to_value_unchecked(sc, opt2_sym(args)); + obj = lookup(sc, opt2_sym(args)); if (is_pair(obj)) obj = car(obj); else obj = g_car(sc, set_plist_1(sc, obj)); @@ -35135,7 +35153,7 @@ static s7_pointer g_member_sq(s7_scheme { s7_pointer obj, lst; lst = opt2_con(args); /* cadadr(args); */ - obj = symbol_to_value_unchecked(sc, car(args)); + obj = lookup(sc, car(args)); if (is_simple(obj)) return(s7_memq(sc, obj, lst)); @@ -35150,8 +35168,8 @@ static s7_pointer g_member_ss(s7_scheme { s7_pointer obj, x; - obj = symbol_to_value_unchecked(sc, car(args)); - x = symbol_to_value_unchecked(sc, cadr(args)); + obj = lookup(sc, car(args)); + x = lookup(sc, cadr(args)); if (!is_pair(x)) { if (is_null(x)) return(sc->F); @@ -35510,18 +35528,17 @@ static const char *make_type_name(s7_sch static inline s7_pointer typed_vector_setter(s7_scheme *sc, s7_pointer vec, s7_int loc, s7_pointer val) { - if (sc->safety < 0) /* or == 0?? */ - vector_element(vec, loc) = val; - else + if ((sc->safety < 0) || /* or == 0?? */ + (c_function_call(typed_vector_typer(vec))(sc, set_plist_1(sc, val)) != sc->F)) { - if (c_function_call(typed_vector_typer(vec))(sc, set_plist_1(sc, val)) != sc->F) - vector_element(vec, loc) = val; - else s7_wrong_type_arg_error(sc, "vector_set!", 3, val, - make_type_name(sc, symbol_name(c_function_symbol(typed_vector_typer(vec))), INDEFINITE_ARTICLE)); + vector_element(vec, loc) = val; + return(val); } - return(val); + return(s7_wrong_type_arg_error(sc, "vector_set!", 3, val, + make_type_name(sc, symbol_name(c_function_symbol(typed_vector_typer(vec))), INDEFINITE_ARTICLE))); } + static s7_pointer default_vector_getter(s7_scheme *sc, s7_pointer vec, s7_int loc) { return(vector_element(vec, loc)); @@ -35674,9 +35691,6 @@ static s7_pointer make_vector_1(s7_schem b = mallocate_vector(sc, len * sizeof(s7_pointer)); vector_block(x) = b; vector_elements(x) = (s7_pointer *)block_data(b); - if (!vector_elements(x)) - return(s7_error(sc, make_symbol(sc, "out-of-memory"), - set_elist_1(sc, wrap_string(sc, "make-vector allocation failed!", 30)))); vector_getter(x) = default_vector_getter; vector_setter(x) = default_vector_setter; if (filled) @@ -35689,9 +35703,6 @@ static s7_pointer make_vector_1(s7_schem b = mallocate_vector(sc, len * sizeof(s7_double)); vector_block(x) = b; float_vector_floats(x) = (s7_double *)block_data(b); - if (!float_vector_floats(x)) - return(s7_error(sc, make_symbol(sc, "out-of-memory"), - set_elist_1(sc, wrap_string(sc, "make-float-vector allocation failed!", 36)))); if (filled) { if ((len & 0x7) == 0) @@ -35708,9 +35719,6 @@ static s7_pointer make_vector_1(s7_schem b = mallocate_vector(sc, len * sizeof(s7_int)); vector_block(x) = b; int_vector_ints(x) = (s7_int *)block_data(b); - if (!int_vector_ints(x)) - return(s7_error(sc, make_symbol(sc, "out-of-memory"), - set_elist_1(sc, wrap_string(sc, "make-int-vector allocation failed!", 34)))); if (filled) { if ((len & 0x7) == 0) @@ -36013,7 +36021,7 @@ static s7_pointer g_vector_fill_1(s7_sch if (end == 0) return(fill); if ((start == 0) && (end == vector_length(x))) - s7_vector_fill(sc, x, fill); /* TODO: this should accept indices rather than repeating code below */ + s7_vector_fill(sc, x, fill); else { s7_int i; @@ -36410,6 +36418,7 @@ static s7_pointer g_vector(s7_scheme *sc return(vec); } +/* -------------------------------- float-vector? -------------------------------- */ static s7_pointer g_is_float_vector(s7_scheme *sc, s7_pointer args) { #define H_is_float_vector "(float-vector? obj) returns #t if obj is an homogeneous float vector" @@ -36417,6 +36426,7 @@ static s7_pointer g_is_float_vector(s7_s check_boolean_method(sc, s7_is_float_vector, sc->is_float_vector_symbol, args); } +/* -------------------------------- float-vector -------------------------------- */ static s7_pointer g_float_vector(s7_scheme *sc, s7_pointer args) { #define H_float_vector "(float-vector ...) returns an homogeneous float vector whose elements are the arguments" @@ -36427,22 +36437,28 @@ static s7_pointer g_float_vector(s7_sche len = safe_list_length(args); vec = make_simple_float_vector(sc, len); - sc->w = vec; if (len > 0) { s7_int i; s7_pointer x; + sc->w = vec; for (x = args, i = 0; is_pair(x); x = cdr(x), i++) { - if (s7_is_real(car(x))) /* bignum is ok here */ - float_vector(vec, i) = s7_real(car(x)); - else return(simple_wrong_type_argument(sc, sc->float_vector_symbol, car(x), T_REAL)); + if (is_t_real(car(x))) + float_vector(vec, i) = real(car(x)); + else + { + if (s7_is_real(car(x))) /* bignum is ok here */ + float_vector(vec, i) = s7_real(car(x)); + else return(simple_wrong_type_argument(sc, sc->float_vector_symbol, car(x), T_REAL)); + } } + sc->w = sc->nil; } - sc->w = sc->nil; return(vec); } +/* -------------------------------- int-vector? -------------------------------- */ static s7_pointer g_is_int_vector(s7_scheme *sc, s7_pointer args) { #define H_is_int_vector "(int-vector? obj) returns #t if obj is an homogeneous s7_int vector" @@ -36450,6 +36466,7 @@ static s7_pointer g_is_int_vector(s7_sch check_boolean_method(sc, is_int_vector, sc->is_int_vector_symbol, args); } +/* -------------------------------- int-vector -------------------------------- */ static s7_pointer g_int_vector(s7_scheme *sc, s7_pointer args) { #define H_int_vector "(int-vector ...) returns an homogeneous s7_int vector whose elements are the arguments" @@ -36465,11 +36482,16 @@ static s7_pointer g_int_vector(s7_scheme s7_int i; s7_pointer x; for (x = args, i = 0; is_pair(x); x = cdr(x), i++) - int_vector(vec, i) = s7_number_to_integer_with_caller(sc, car(x), "int-vector"); + { + if (is_t_integer(car(x))) + int_vector(vec, i) = integer(car(x)); + else int_vector(vec, i) = s7_number_to_integer_with_caller(sc, car(x), "int-vector"); + } } return(vec); } +/* -------------------------------- byte-vector? -------------------------------- */ static s7_pointer g_is_byte_vector(s7_scheme *sc, s7_pointer args) { #define H_is_byte_vector "(byte-vector? obj) returns #t if obj is a byte-vector" @@ -36478,6 +36500,7 @@ static s7_pointer g_is_byte_vector(s7_sc check_boolean_method(sc, s7_is_byte_vector, sc->is_byte_vector_symbol, args); } +/* -------------------------------- byte-vector -------------------------------- */ static s7_pointer g_byte_vector(s7_scheme *sc, s7_pointer args) { #define H_byte_vector "(byte-vector ...) returns a byte-vector whose elements are the arguments" @@ -36775,6 +36798,7 @@ a vector that points to the same element static s7_pointer vector_ref_1(s7_scheme *sc, s7_pointer vect, s7_pointer indices, bool implicit_ok) { s7_int index = 0; + /* fprintf(stderr, "%s: %s %s\n", __func__, DISPLAY(vect), DISPLAY(indices)); */ if (vector_length(vect) == 0) return(out_of_range(sc, sc->vector_ref_symbol, small_int(1), vect, its_too_large_string)); @@ -36871,7 +36895,7 @@ static s7_pointer g_vector_ref(s7_scheme static s7_pointer g_vector_ref_ic_n(s7_scheme *sc, s7_pointer args, s7_int index) { s7_pointer vec; - vec = symbol_to_value_unchecked(sc, car(args)); + vec = lookup(sc, car(args)); if (!is_any_vector(vec)) return(method_or_bust(sc, vec, sc->vector_ref_symbol, list_2(sc, vec, cadr(args)), T_VECTOR, 1)); @@ -36904,6 +36928,26 @@ static s7_pointer vector_ref_p_pi_direct return(v); } +static s7_pointer vector_ref_p_pii(s7_scheme *sc, s7_pointer v, s7_int i1, s7_int i2) +{ + if ((!is_any_vector(v)) || + (vector_rank(v) != 2) || + (i1 < 0) || (i2 < 0) || + (i1 >= vector_dimension(v, 0)) || + (i2 >= vector_dimension(v, 1))) + return(g_vector_ref(sc, set_plist_3(sc, v, make_integer(sc, i1), make_integer(sc, i2)))); + return(vector_getter(v)(sc, v, i2 + (i1 * vector_offset(v, 0)))); +} + +static s7_pointer vector_ref_p_pii_direct(s7_scheme *sc, s7_pointer v, s7_int i1, s7_int i2) +{ + if ((i1 < 0) || (i2 < 0) || + (i1 >= vector_dimension(v, 0)) || + (i2 >= vector_dimension(v, 1))) + return(g_vector_ref(sc, set_plist_3(sc, v, make_integer(sc, i1), make_integer(sc, i2)))); + return(vector_element(v, i2 + (i1 * vector_offset(v, 0)))); +} + /* this is specific to T_VECTOR */ static s7_pointer vector_ref_unchecked(s7_scheme *sc, s7_pointer v, s7_int i) { @@ -36927,15 +36971,13 @@ static s7_pointer g_vector_ref_2(s7_sche vec = car(args); if (!is_any_vector(vec)) - return(method_or_bust(sc, vec, sc->vector_ref_symbol, args, T_VECTOR, 1)); /* should be ok because we go to g_vector_ref below */ - - if (vector_rank(vec) > 1) + return(g_vector_ref(sc, args)); + if (vector_rank(vec) != 1) return(g_vector_ref(sc, args)); ind = cadr(args); if (!s7_is_integer(ind)) - return(method_or_bust(sc, ind, sc->vector_ref_symbol, args, T_INTEGER, 2)); - + return(g_vector_ref(sc, args)); index = s7_integer(ind); if ((index < 0) || (index >= vector_length(vec))) return(out_of_range(sc, sc->vector_ref_symbol, small_int(2), ind, (index < 0) ? its_negative_string : its_too_large_string)); @@ -36943,6 +36985,37 @@ static s7_pointer g_vector_ref_2(s7_sche return(vector_getter(vec)(sc, vec, index)); } +static s7_pointer g_vector_ref_3(s7_scheme *sc, s7_pointer args) +{ + s7_pointer vec, i1, i2; + s7_int ix, iy; + + vec = car(args); + if (!is_any_vector(vec)) + return(g_vector_ref(sc, args)); + if (vector_rank(vec) != 2) + return(g_vector_ref(sc, args)); + + i1 = cadr(args); + if (!s7_is_integer(i1)) + return(g_vector_ref(sc, args)); + i2 = caddr(args); + if (!s7_is_integer(i2)) + return(g_vector_ref(sc, args)); + ix = s7_integer(i1); + iy = s7_integer(i2); + if ((ix >= 0) && + (iy >= 0) && + (ix < vector_dimension(vec, 0)) && + (iy < vector_dimension(vec, 1))) + { + s7_int index; + index = (ix * vector_offset(vec, 0)) + iy; /* vector_offset(vec, 1) == 1 */ + return(vector_getter(vec)(sc, vec, index)); + } + return(g_vector_ref(sc, args)); +} + static s7_pointer g_vector_ref_2_direct(s7_scheme *sc, s7_pointer args) { s7_pointer vec, ind; @@ -36950,7 +37023,7 @@ static s7_pointer g_vector_ref_2_direct( vec = car(args); ind = cadr(args); if (!s7_is_integer(ind)) - return(method_or_bust(sc, ind, sc->vector_ref_symbol, args, T_INTEGER, 2)); + return(wrong_type_argument(sc, sc->vector_ref_symbol, 2, ind, T_INTEGER)); index = s7_integer(ind); if ((index < 0) || (index >= vector_length(vec))) return(out_of_range(sc, sc->vector_ref_symbol, small_int(2), ind, (index < 0) ? its_negative_string : its_too_large_string)); @@ -36993,7 +37066,7 @@ static s7_pointer g_vector_set(s7_scheme if (!s7_is_integer(p1)) return(wrong_type_argument(sc, sc->vector_set_symbol, i + 2, p, T_INTEGER)); n = s7_integer(p1); - } + } else n = s7_integer(p); if ((n < 0) || (n >= vector_dimension(vec, i))) @@ -37067,6 +37140,33 @@ static s7_pointer vector_set_p_pip_direc return(p); } +static s7_pointer vector_set_p_piip(s7_scheme *sc, s7_pointer v, s7_int i1, s7_int i2, s7_pointer p) +{ + if ((!is_any_vector(v)) || + (vector_rank(v) != 2) || + (i1 < 0) || (i2 < 0) || + (i1 >= vector_dimension(v, 0)) || + (i2 >= vector_dimension(v, 1))) + return(g_vector_set(sc, set_elist_4(sc, v, make_integer(sc, i1), make_integer(sc, i2), p))); + + if (is_typed_vector(v)) + return(typed_vector_setter(sc, v, i2 + (i1 * vector_offset(v, 0)), p)); + + vector_setter(v)(sc, v, i2 + (i1 * vector_offset(v, 0)), p); + return(p); +} + +static s7_pointer vector_set_p_piip_direct(s7_scheme *sc, s7_pointer v, s7_int i1, s7_int i2, s7_pointer p) +{ + /* normal untyped vector, rank == 2 */ + if ((i1 < 0) || (i2 < 0) || + (i1 >= vector_dimension(v, 0)) || + (i2 >= vector_dimension(v, 1))) + return(g_vector_set(sc, set_elist_4(sc, v, make_integer(sc, i1), make_integer(sc, i2), p))); + vector_element(v, i2 + (i1 * vector_offset(v, 0))) = p; + return(p); +} + static s7_pointer typed_vector_set_p_pip_direct(s7_scheme *sc, s7_pointer v, s7_int i, s7_pointer p) { if ((i >= 0) && (i < vector_length(v))) @@ -37075,6 +37175,15 @@ static s7_pointer typed_vector_set_p_pip return(p); } +static s7_pointer typed_vector_set_p_piip_direct(s7_scheme *sc, s7_pointer v, s7_int i1, s7_int i2, s7_pointer p) +{ + if ((i1 < 0) || (i2 < 0) || + (i1 >= vector_dimension(v, 0)) || + (i2 >= vector_dimension(v, 1))) + return(g_vector_set(sc, set_elist_4(sc, v, make_integer(sc, i1), make_integer(sc, i2), p))); + return(typed_vector_setter(sc, v, i2 + (i1 * vector_offset(v, 0)), p)); +} + static s7_pointer vector_set_unchecked(s7_scheme *sc, s7_pointer v, s7_int i, s7_pointer p) { vector_element(v, i) = p; @@ -37093,21 +37202,21 @@ static s7_pointer g_vector_set_ic(s7_sch s7_pointer vec, val; s7_int index; - vec = symbol_to_value_unchecked(sc, car(args)); + vec = lookup(sc, car(args)); if (!is_any_vector(vec)) - return(method_or_bust(sc, vec, sc->vector_set_symbol, list_3(sc, vec, cadr(args), symbol_to_value_unchecked(sc, caddr(args))), T_VECTOR, 1)); + return(method_or_bust(sc, vec, sc->vector_set_symbol, list_3(sc, vec, cadr(args), lookup(sc, caddr(args))), T_VECTOR, 1)); /* the list_3 happens only if we find the method */ if (is_immutable_vector(vec)) return(immutable_object_error(sc, set_elist_3(sc, immutable_error_string, sc->vector_set_symbol, vec))); if (vector_rank(vec) > 1) - return(g_vector_set(sc, set_plist_3(sc, vec, cadr(args), symbol_to_value_unchecked(sc, caddr(args))))); + return(g_vector_set(sc, set_plist_3(sc, vec, cadr(args), lookup(sc, caddr(args))))); index = s7_integer(cadr(args)); if (index >= vector_length(vec)) return(out_of_range(sc, sc->vector_set_symbol, small_int(2), cadr(args), its_too_large_string)); - val = symbol_to_value_unchecked(sc, caddr(args)); + val = lookup(sc, caddr(args)); if (is_typed_vector(vec)) return(typed_vector_setter(sc, vec, index, val)); @@ -37119,12 +37228,13 @@ static s7_pointer g_vector_set_ic(s7_sch static s7_pointer g_vector_set_3(s7_scheme *sc, s7_pointer args) { + /* (vector-set! vector index value) */ s7_pointer ind, vec, val; s7_int index; vec = car(args); if (!is_any_vector(vec)) - return(method_or_bust(sc, vec, sc->vector_set_symbol, args, T_VECTOR, 1)); + return(g_vector_set(sc, args)); if (is_immutable_vector(vec)) return(immutable_object_error(sc, set_elist_3(sc, immutable_error_string, sc->vector_set_symbol, vec))); if (vector_rank(vec) > 1) @@ -37132,20 +37242,13 @@ static s7_pointer g_vector_set_3(s7_sche ind = cadr(args); if (!s7_is_integer(ind)) - { - s7_pointer p; - p = check_value_slot(sc, ind); - if (!s7_is_integer(p)) - return(wrong_type_argument(sc, sc->vector_set_symbol, 2, ind, T_INTEGER)); - index = s7_integer(p); - } - else index = s7_integer(ind); + return(g_vector_set(sc, args)); + index = s7_integer(ind); if ((index < 0) || (index >= vector_length(vec))) return(out_of_range(sc, sc->vector_set_symbol, small_int(2), wrap_integer1(sc, index), (index < 0) ? its_negative_string : its_too_large_string)); val = caddr(args); - if (is_typed_vector(vec)) return(typed_vector_setter(sc, vec, index, val)); @@ -37715,7 +37818,7 @@ static s7_pointer univect_ref(s7_scheme p = check_value_slot(sc, index); if (!s7_is_integer(p)) return(wrong_type_argument(sc, caller, 2, index, T_INTEGER)); - else index = p; + index = p; } ind = s7_integer(index); if ((ind < 0) || (ind >= vector_length(v))) @@ -37857,7 +37960,7 @@ static s7_pointer g_float_vector_ref(s7_ return(univect_ref(sc, args, sc->float_vector_ref_symbol, T_FLOAT_VECTOR)); } -static s7_pointer g_fv_ref(s7_scheme *sc, s7_pointer args) +static s7_pointer g_fv_ref_2(s7_scheme *sc, s7_pointer args) { s7_pointer fv, index; s7_int ind; @@ -37911,10 +38014,22 @@ static inline s7_int ref_check_index(s7_ static s7_double float_vector_ref_d_7pi(s7_scheme *sc, s7_pointer v, s7_int i) {return(float_vector(v, ref_check_index(sc, v, i)));} static s7_pointer float_vector_ref_unchecked_p(s7_scheme *sc, s7_pointer v, s7_int i) {return(make_real(sc, float_vector(v, i)));} +static s7_double float_vector_ref_d_7pii(s7_scheme *sc, s7_pointer v, s7_int i1, s7_int i2) +{ + if ((i1 >= 0) && (i1 < vector_dimension(v, 0))) + { + if ((i2 >= 0) && (i2 < vector_dimension(v, 1))) + return(float_vector(v, i2 + (i1 * vector_offset(v, 0)))); + out_of_range(sc, sc->float_vector_ref_symbol, small_int(3), wrap_integer1(sc, i2), (i2 < 0) ? its_negative_string : its_too_large_string); + } + out_of_range(sc, sc->float_vector_ref_symbol, small_int(2), wrap_integer1(sc, i1), (i1 < 0) ? its_negative_string : its_too_large_string); + return(0); +} + static s7_pointer float_vector_ref_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) { if (args == 2) - return(sc->fv_ref); + return(sc->fv_ref_2); if (args == 3) return(sc->fv_ref_3); return(f); @@ -37928,7 +38043,7 @@ static s7_pointer g_float_vector_set(s7_ return(univect_set(sc, args, sc->float_vector_set_symbol, T_FLOAT_VECTOR)); } -static s7_pointer g_fv_set(s7_scheme *sc, s7_pointer args) +static s7_pointer g_fv_set_3(s7_scheme *sc, s7_pointer args) { s7_pointer fv, index, value; s7_int ind; @@ -38009,7 +38124,7 @@ static s7_pointer float_vector_set_choos { if (find_matching_ref(sc, sc->float_vector_ref_symbol, expr)) return(sc->fv_set_unchecked); - return(sc->fv_set); + return(sc->fv_set_3); } return(f); } @@ -38023,6 +38138,20 @@ static s7_int set_check_index(s7_scheme } static s7_double float_vector_set_d_7pid(s7_scheme *sc, s7_pointer v, s7_int i, s7_double x) {float_vector(v, (set_check_index(sc, v, i))) = x; return(x);} +static s7_double float_vector_set_d_7piid(s7_scheme *sc, s7_pointer v, s7_int i1, s7_int i2, s7_double x) +{ + if ((i1 >= 0) && (i1 < vector_dimension(v, 0))) + { + if ((i2 >= 0) && (i2 < vector_dimension(v, 1))) + { + float_vector(v, i2 + (i1 * vector_offset(v, 0))) = x; + return(x); + } + out_of_range(sc, sc->float_vector_set_symbol, small_int(3), wrap_integer1(sc, i2), (i2 < 0) ? its_negative_string : its_too_large_string); + } + out_of_range(sc, sc->float_vector_set_symbol, small_int(2), wrap_integer1(sc, i1), (i1 < 0) ? its_negative_string : its_too_large_string); + return(x); +} static s7_pointer float_vector_set_unchecked_p(s7_scheme *sc, s7_pointer v, s7_int i, s7_pointer p) { @@ -38047,9 +38176,22 @@ static s7_int int_vector_ref_i_7pi(s7_sc out_of_range(sc, sc->int_vector_ref_symbol, small_int(2), wrap_integer1(sc, i), (i < 0) ? its_negative_string : its_too_large_string); return(0); } + static s7_pointer int_vector_ref_unchecked_p(s7_scheme *sc, s7_pointer v, s7_int i) {return(make_integer(sc, int_vector(v, i)));} -static s7_pointer g_iv_ref(s7_scheme *sc, s7_pointer args) +static s7_int int_vector_ref_i_7pii(s7_scheme *sc, s7_pointer v, s7_int i1, s7_int i2) +{ + if ((i1 >= 0) && (i1 < vector_dimension(v, 0))) + { + if ((i2 >= 0) && (i2 < vector_dimension(v, 1))) + return(int_vector(v, i2 + (i1 * vector_offset(v, 0)))); + out_of_range(sc, sc->int_vector_ref_symbol, small_int(3), wrap_integer1(sc, i2), (i2 < 0) ? its_negative_string : its_too_large_string); + } + out_of_range(sc, sc->int_vector_ref_symbol, small_int(2), wrap_integer1(sc, i1), (i1 < 0) ? its_negative_string : its_too_large_string); + return(0); +} + +static s7_pointer g_iv_ref_2(s7_scheme *sc, s7_pointer args) { s7_pointer v, index; s7_int ind; @@ -38067,7 +38209,7 @@ static s7_pointer g_iv_ref(s7_scheme *sc return(make_integer(sc, int_vector(v, ind))); } -static s7_pointer g_iv_ref_0(s7_scheme *sc, s7_pointer args) +static s7_pointer g_iv_ref_2i(s7_scheme *sc, s7_pointer args) { s7_pointer v; v = car(args); @@ -38080,14 +38222,41 @@ static s7_pointer g_iv_ref_0(s7_scheme * return(make_integer(sc, int_vector(v, 0))); } +static s7_pointer g_iv_ref_3(s7_scheme *sc, s7_pointer args) +{ + s7_pointer iv, index; + s7_int ind1, ind2; + iv = car(args); + if (!is_int_vector(iv)) + return(method_or_bust(sc, iv, sc->int_vector_ref_symbol, args, T_INT_VECTOR, 1)); + if (vector_rank(iv) != 2) + return(univect_ref(sc, args, sc->int_vector_ref_symbol, T_INT_VECTOR)); + index = cadr(args); + if (!s7_is_integer(index)) + return(wrong_type_argument(sc, sc->int_vector_ref_symbol, 2, index, T_INTEGER)); + ind1 = s7_integer(index); + if ((ind1 < 0) || (ind1 >= vector_dimension(iv, 0))) + return(simple_out_of_range(sc, sc->int_vector_ref_symbol, index, (ind1 < 0) ? its_negative_string : its_too_large_string)); + index = caddr(args); + if (!s7_is_integer(index)) + return(wrong_type_argument(sc, sc->int_vector_ref_symbol, 3, index, T_INTEGER)); + ind2 = s7_integer(index); + if ((ind2 < 0) || (ind2 >= vector_dimension(iv, 1))) + return(simple_out_of_range(sc, sc->int_vector_ref_symbol, index, (ind2 < 0) ? its_negative_string : its_too_large_string)); + ind1 = ind1 * vector_offset(iv, 0) + ind2; + return(make_integer(sc, int_vector(iv, ind1))); +} + static s7_pointer int_vector_ref_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) { if (args == 2) { if ((is_t_integer(caddr(expr))) && (s7_integer(caddr(expr)) == 0)) - return(sc->iv_ref_0); - return(sc->iv_ref); + return(sc->iv_ref_2i); + return(sc->iv_ref_2); } + if (args == 3) + return(sc->iv_ref_3); return(f); } @@ -38108,6 +38277,22 @@ static s7_int int_vector_set_i_7pii(s7_s int_vector(v, i) = x; return(x); } + +static s7_int int_vector_set_i_7piii(s7_scheme *sc, s7_pointer v, s7_int i1, s7_int i2, s7_int i3) +{ + if ((i1 >= 0) && (i1 < vector_dimension(v, 0))) + { + if ((i2 >= 0) && (i2 < vector_dimension(v, 1))) + { + int_vector(v, i2 + (i1 * vector_offset(v, 0))) = i3; + return(i3); + } + out_of_range(sc, sc->int_vector_set_symbol, small_int(3), wrap_integer1(sc, i2), (i2 < 0) ? its_negative_string : its_too_large_string); + } + out_of_range(sc, sc->int_vector_set_symbol, small_int(2), wrap_integer1(sc, i1), (i1 < 0) ? its_negative_string : its_too_large_string); + return(0); +} + static s7_pointer int_vector_set_unchecked_p(s7_scheme *sc, s7_pointer v, s7_int i, s7_pointer p) { if (!s7_is_integer(p)) @@ -38116,7 +38301,7 @@ static s7_pointer int_vector_set_uncheck return(p); } -static s7_pointer g_iv_set(s7_scheme *sc, s7_pointer args) +static s7_pointer g_iv_set_3(s7_scheme *sc, s7_pointer args) { s7_pointer v, index, value; s7_int ind; @@ -38143,7 +38328,7 @@ static s7_pointer g_iv_set(s7_scheme *sc static s7_pointer int_vector_set_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) { if (args == 3) - return(sc->iv_set); + return(sc->iv_set_3); return(f); } @@ -38158,17 +38343,28 @@ static s7_pointer g_byte_vector_ref(s7_s static s7_int byte_vector_ref_i_7pi(s7_scheme *sc, s7_pointer p1, s7_int i1) { - if (!is_byte_vector(p1)) - simple_wrong_type_argument_with_type(sc, sc->byte_vector_ref_symbol, p1, a_byte_vector_string); if ((i1 >= 0) && (i1 < byte_vector_length(p1))) return((s7_int)((byte_vector(p1, i1)))); out_of_range(sc, sc->byte_vector_ref_symbol, small_int(2), wrap_integer1(sc, i1), (i1 < 0) ? its_negative_string : its_too_large_string); return(0); } -static s7_pointer byte_vector_ref_unchecked(s7_scheme *sc, s7_pointer p1, s7_int i1) {return(small_int((byte_vector(p1, i1))));} +static s7_int byte_vector_ref_i_7pii(s7_scheme *sc, s7_pointer v, s7_int i1, s7_int i2) +{ + if ((i1 >= 0) && (i1 < vector_dimension(v, 0))) + { + if ((i2 >= 0) && (i2 < vector_dimension(v, 1))) + return((s7_int)byte_vector(v, i2 + (i1 * vector_offset(v, 0)))); + out_of_range(sc, sc->byte_vector_ref_symbol, small_int(3), wrap_integer1(sc, i2), (i2 < 0) ? its_negative_string : its_too_large_string); + } + out_of_range(sc, sc->byte_vector_ref_symbol, small_int(2), wrap_integer1(sc, i1), (i1 < 0) ? its_negative_string : its_too_large_string); + return(0); +} + +static s7_pointer byte_vector_ref_unchecked_p(s7_scheme *sc, s7_pointer p1, s7_int i1) {return(small_int((byte_vector(p1, i1))));} +static s7_int byte_vector_ref_unchecked(s7_scheme *sc, s7_pointer p1, s7_int i1) {return(byte_vector(p1, i1));} -static s7_pointer g_bv_ref(s7_scheme *sc, s7_pointer args) +static s7_pointer g_bv_ref_2(s7_scheme *sc, s7_pointer args) { s7_pointer v, index; s7_int ind; @@ -38186,10 +38382,37 @@ static s7_pointer g_bv_ref(s7_scheme *sc return(make_integer(sc, byte_vector(v, ind))); } +static s7_pointer g_bv_ref_3(s7_scheme *sc, s7_pointer args) +{ + s7_pointer iv, index; + s7_int ind1, ind2; + iv = car(args); + if (!is_byte_vector(iv)) + return(method_or_bust(sc, iv, sc->byte_vector_ref_symbol, args, T_BYTE_VECTOR, 1)); + if (vector_rank(iv) != 2) + return(univect_ref(sc, args, sc->byte_vector_ref_symbol, T_BYTE_VECTOR)); + index = cadr(args); + if (!s7_is_integer(index)) + return(wrong_type_argument(sc, sc->byte_vector_ref_symbol, 2, index, T_INTEGER)); + ind1 = s7_integer(index); + if ((ind1 < 0) || (ind1 >= vector_dimension(iv, 0))) + return(simple_out_of_range(sc, sc->byte_vector_ref_symbol, index, (ind1 < 0) ? its_negative_string : its_too_large_string)); + index = caddr(args); + if (!s7_is_integer(index)) + return(wrong_type_argument(sc, sc->byte_vector_ref_symbol, 3, index, T_INTEGER)); + ind2 = s7_integer(index); + if ((ind2 < 0) || (ind2 >= vector_dimension(iv, 1))) + return(simple_out_of_range(sc, sc->byte_vector_ref_symbol, index, (ind2 < 0) ? its_negative_string : its_too_large_string)); + ind1 = ind1 * vector_offset(iv, 0) + ind2; + return(make_integer(sc, byte_vector(iv, ind1))); +} + static s7_pointer byte_vector_ref_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) { if (args == 2) - return(sc->bv_ref); + return(sc->bv_ref_2); + if (args == 3) + return(sc->bv_ref_3); return(f); } @@ -38214,9 +38437,27 @@ static s7_int byte_vector_set_i_7pii(s7_ return(i2); } -static s7_pointer byte_vector_set_unchecked(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_pointer p2) {byte_vector(p1, i1) = (uint8_t)s7_integer(p2); return(p2);} +static s7_int byte_vector_set_unchecked(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_int i2) {byte_vector(p1, i1) = (uint8_t)i2; return(i2);} +static s7_pointer byte_vector_set_unchecked_p(s7_scheme *sc, s7_pointer p1, s7_int i1, s7_pointer p2) {byte_vector(p1, i1) = (uint8_t)s7_integer(p2); return(p2);} + +static s7_int byte_vector_set_i_7piii(s7_scheme *sc, s7_pointer v, s7_int i1, s7_int i2, s7_int i3) +{ + if ((i3 < 0) || (i3 > 255)) + simple_wrong_type_argument_with_type(sc, sc->byte_vector_set_symbol, wrap_integer1(sc, i3), an_unsigned_byte_string); + if ((i1 >= 0) && (i1 < vector_dimension(v, 0))) + { + if ((i2 >= 0) && (i2 < vector_dimension(v, 1))) + { + byte_vector(v, i2 + (i1 * vector_offset(v, 0))) = i3; + return(i3); + } + out_of_range(sc, sc->int_vector_set_symbol, small_int(3), wrap_integer1(sc, i2), (i2 < 0) ? its_negative_string : its_too_large_string); + } + out_of_range(sc, sc->int_vector_set_symbol, small_int(2), wrap_integer1(sc, i1), (i1 < 0) ? its_negative_string : its_too_large_string); + return(0); +} -static s7_pointer g_bv_set(s7_scheme *sc, s7_pointer args) +static s7_pointer g_bv_set_3(s7_scheme *sc, s7_pointer args) { s7_pointer v, index, value; s7_int ind, uval; @@ -38248,7 +38489,7 @@ static s7_pointer g_bv_set(s7_scheme *sc static s7_pointer byte_vector_set_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) { if (args == 3) - return(sc->bv_set); + return(sc->bv_set_3); return(f); } @@ -38265,7 +38506,7 @@ static bool c_function_is_ok(s7_scheme * p = car(x); /* function name (symbol) */ if (is_global(p)) p = slot_value(global_slot(p)); - else p = symbol_to_value_checked(sc, p); + else p = lookup_checked(sc, p); /* this is nearly always global and p == opt1_cfunc(x) * p can be null if we evaluate some code, optimizing it, then eval it again in a context @@ -38647,7 +38888,7 @@ static s7_pointer g_sort(s7_scheme *sc, (car(largs) == cadr(expr)) && (cadr(largs) == caddr(expr))) { - lp = symbol_to_value_unchecked(sc, car(expr)); + lp = lookup(sc, car(expr)); sc->sort_f = s7_b_7pp_function(lp); if (sc->sort_f) { @@ -38663,7 +38904,7 @@ static s7_pointer g_sort(s7_scheme *sc, (car(largs) == cadadr(expr)) && (cadr(largs) == cadr(caddr(expr)))) { - lp = symbol_to_value_unchecked(sc, car(expr)); + lp = lookup(sc, car(expr)); sc->sort_f = s7_b_7pp_function(lp); if (sc->sort_f) { @@ -39235,10 +39476,7 @@ static hash_entry_t *make_hash_entry(s7_ /* -------------------------------- hash-table? -------------------------------- */ -bool s7_is_hash_table(s7_pointer p) -{ - return(is_hash_table(p)); -} +bool s7_is_hash_table(s7_pointer p) {return(is_hash_table(p));} static s7_pointer g_is_hash_table(s7_scheme *sc, s7_pointer args) { @@ -40155,12 +40393,9 @@ static s7_pointer g_make_hash_table_1(s7 } return(wrong_type_argument_with_type(sc, caller, 2, proc, wrap_string(sc, "a cons of two functions", 23))); } - else - { - if (proc == sc->F) /* TODO: here if dproc/typers set the procs (or above?) */ - return(ht); - return(wrong_type_argument_with_type(sc, caller, 2, proc, wrap_string(sc, "a cons of two functions", 23))); - } + if (proc == sc->F) + return(ht); + return(wrong_type_argument_with_type(sc, caller, 2, proc, wrap_string(sc, "a cons of two functions", 23))); } } } @@ -40369,8 +40604,8 @@ static s7_pointer g_hash_table_ref_ss(s7 s7_pointer table, key; hash_entry_t *x; - table = symbol_to_value_unchecked(sc, car(args)); - key = symbol_to_value_unchecked(sc, cadr(args)); + table = lookup(sc, car(args)); + key = lookup(sc, cadr(args)); if (!is_hash_table(table)) return(method_or_bust(sc, table, sc->hash_table_ref_symbol, list_2(sc, table, key), T_HASH_TABLE, 1)); @@ -40383,8 +40618,8 @@ static s7_pointer g_hash_table_ref_car(s s7_pointer y, table; hash_entry_t *x; - table = symbol_to_value_unchecked(sc, car(args)); - y = symbol_to_value_unchecked(sc, opt3_sym(args)); + table = lookup(sc, car(args)); + y = lookup(sc, opt3_sym(args)); if (!is_pair(y)) return(simple_wrong_type_argument(sc, sc->car_symbol, y, T_PAIR)); @@ -40405,9 +40640,9 @@ static s7_pointer hash_table_ref_p_pp(s7 static bool op_hash_table_a(s7_scheme *sc) { s7_pointer s; - s = symbol_to_value_checked(sc, car(sc->code)); + s = lookup_checked(sc, car(sc->code)); if (!is_hash_table(s)) {sc->last_function = s; return(false);} - sc->value = s7_hash_table_ref(sc, s, c_call(cdr(sc->code))(sc, cadr(sc->code))); + sc->value = s7_hash_table_ref(sc, s, fx_call(sc, cdr(sc->code))); return(true); } @@ -40616,39 +40851,9 @@ static inline s7_pointer hash_table_add( static s7_pointer g_hash_table(s7_scheme *sc, s7_pointer args) { - #define H_hash_table "(hash-table ...) returns a hash-table containing the cons's passed as its arguments. \ -That is, (hash-table '(\"hi\" . 3) (\"ho\" . 32)) returns a new hash-table with the two key/value pairs preinstalled." - #define Q_hash_table s7_make_circular_signature(sc, 1, 2, sc->is_hash_table_symbol, sc->is_list_symbol) - - s7_int len; - s7_pointer x, ht; - - /* this accepts repeated keys: (hash-table '(a . 1) '(a . 1)) */ - for (len = 0, x = args; is_pair(x); x = cdr(x), len++) - if (!is_list(car(x))) - return(wrong_type_argument(sc, sc->hash_table_symbol, position_of(x, args), car(x), T_PAIR)); - - ht = s7_make_hash_table(sc, (len > sc->default_hash_table_length) ? len : sc->default_hash_table_length); - if (len > 0) - { - s7_int ht_loc; - ht_loc = s7_gc_protect_1(sc, ht); /* hash_table_set can cons, so we need to protect this */ - for (x = args; is_pair(x); x = cdr(x)) - if ((is_pair(car(x))) && - (cdar(x) != sc->F)) /* (hash-table '(a . #f)) */ - hash_table_add(sc, ht, caar(x), cdar(x)); - s7_gc_unprotect_at(sc, ht_loc); - } - return(ht); -} - - -/* -------------------------------- hash-table* -------------------------------- */ -static s7_pointer g_hash_table_star(s7_scheme *sc, s7_pointer args) -{ - #define H_hash_table_star "(hash-table* ...) returns a hash-table containing the symbol/value pairs passed as its arguments. \ -That is, (hash-table* 'a 1 'b 2) returns a new hash-table with the two key/value pairs preinstalled." - #define Q_hash_table_star s7_make_circular_signature(sc, 1, 2, sc->is_hash_table_symbol, sc->T) + #define H_hash_table "(hash-table ...) returns a hash-table containing the symbol/value pairs passed as its arguments. \ +That is, (hash-table 'a 1 'b 2) returns a new hash-table with the two key/value pairs preinstalled." + #define Q_hash_table s7_make_circular_signature(sc, 1, 2, sc->is_hash_table_symbol, sc->T) s7_int len; s7_pointer ht; @@ -40656,7 +40861,7 @@ That is, (hash-table* 'a 1 'b 2) returns len = safe_list_length(args); if (len & 1) return(s7_error(sc, sc->wrong_number_of_args_symbol, - set_elist_2(sc, wrap_string(sc, "hash-table* got an odd number of arguments: ~S", 46), args))); + set_elist_2(sc, wrap_string(sc, "hash-table got an odd number of arguments: ~S", 45), args))); len /= 2; ht = s7_make_hash_table(sc, (len > sc->default_hash_table_length) ? len : sc->default_hash_table_length); @@ -40675,7 +40880,7 @@ That is, (hash-table* 'a 1 'b 2) returns return(ht); } -static s7_pointer g_hash_table_star_2(s7_scheme *sc, s7_pointer args) +static s7_pointer g_hash_table_2(s7_scheme *sc, s7_pointer args) { s7_pointer ht; ht = s7_make_hash_table(sc, sc->default_hash_table_length); @@ -40684,10 +40889,23 @@ static s7_pointer g_hash_table_star_2(s7 return(ht); } -static s7_pointer hash_table_star_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) +/* -------------------------------- weak-hash-table -------------------------------- */ +static s7_pointer g_weak_hash_table(s7_scheme *sc, s7_pointer args) +{ + #define H_weak_hash_table "(weak-hash-table ...) returns a weak-hash-table containing the symbol/value pairs passed as its arguments. \ +That is, (weak-hash-table 'a 1 'b 2) returns a new weak-hash-table with the two key/value pairs preinstalled." + #define Q_weak_hash_table Q_hash_table + + s7_pointer table; + table = g_hash_table(sc, args); + set_weak_hash_table(table); + return(table); +} + +static s7_pointer hash_table_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops) { if (args == 2) - return(sc->hash_table_star_2); + return(sc->hash_table_2); return(f); } @@ -40979,10 +41197,17 @@ static c_proc_t *alloc_permanent_functio return(&(sc->alloc_function_cells[sc->alloc_function_k++])); } +#if S7_DEBUGGING +static s7_int permanent_functions = 0; +#endif + s7_pointer s7_make_function(s7_scheme *sc, const char *name, s7_function f, s7_int required_args, s7_int optional_args, bool rest_arg, const char *doc) { s7_pointer x; x = alloc_pointer(sc); +#if S7_DEBUGGING + permanent_functions++; +#endif x = make_function(sc, name, f, required_args, optional_args, rest_arg, doc, x, alloc_permanent_function(sc)); unheap(sc, x); return(x); @@ -41481,7 +41706,12 @@ static s7_pointer g_signature(s7_scheme if (vector_length(p) == 0) return(sc->F); /* sig () is #f so sig #() should be #f */ if (!is_typed_vector(p)) return(sc->vector_signature); - return(s7_make_circular_signature(sc, 2, 3, c_function_symbol(typed_vector_typer(p)), sc->is_vector_symbol, sc->is_integer_symbol)); + { + s7_pointer lst; + lst = list_3(sc, c_function_symbol(typed_vector_typer(p)), sc->is_vector_symbol, sc->is_integer_symbol); + cdddr(lst) = cddr(lst); + return(lst); + } case T_FLOAT_VECTOR: return((vector_length(p) == 0) ? sc->F : sc->float_vector_signature); case T_INT_VECTOR: return((vector_length(p) == 0) ? sc->F : sc->int_vector_signature); @@ -41491,7 +41721,7 @@ static s7_pointer g_signature(s7_scheme case T_HASH_TABLE: if (is_typed_hash_table(p)) - return(s7_make_signature(sc, 3, c_function_symbol(hash_table_value_typer(p)), sc->is_hash_table_symbol, c_function_symbol(hash_table_key_typer(p)))); + return(list_3(sc, c_function_symbol(hash_table_value_typer(p)), sc->is_hash_table_symbol, c_function_symbol(hash_table_key_typer(p)))); return(sc->hash_table_signature); case T_ITERATOR: @@ -41599,7 +41829,7 @@ static s7_pointer g_c_object_set(s7_sche s7_pointer obj; obj = car(args); if (!is_c_object(obj)) - return(simple_wrong_type_argument(sc, s7_make_symbol(sc, "c-object-set!"), obj, T_C_OBJECT)); + return(simple_wrong_type_argument(sc, make_symbol(sc, "c-object-set!"), obj, T_C_OBJECT)); return((*(c_object_set(sc, obj)))(sc, args)); } @@ -41623,6 +41853,8 @@ s7_int s7_make_c_type(s7_scheme *sc, con sc->c_object_types[tag] = (c_object_t *)calloc(1, sizeof(c_object_t)); sc->c_object_types[tag]->type = tag; sc->c_object_types[tag]->scheme_name = s7_make_permanent_string(sc, name); + sc->c_object_types[tag]->getter = sc->F; + sc->c_object_types[tag]->setter = sc->F; sc->c_object_types[tag]->free = fallback_free; #if (!DISABLE_DEPRECATED) @@ -41665,11 +41897,27 @@ void s7_c_type_set_ref(s7_scheme *sc, s7 sc->c_object_types[tag]->outer_type = (T_C_OBJECT | T_SAFE_PROCEDURE); } +void s7_c_type_set_getter(s7_scheme *sc, s7_int tag, s7_pointer getter) +{ +#if S7_DEBUGGING + if (!is_c_function(getter)) fprintf(stderr, "%s[%d]: %p is not a c_function\n", __func__, __LINE__, getter); +#endif + sc->c_object_types[tag]->getter = getter; +} + void s7_c_type_set_set(s7_scheme *sc, s7_int tag, s7_pointer (*set)(s7_scheme *sc, s7_pointer args)) { sc->c_object_types[tag]->set = set; } +void s7_c_type_set_setter(s7_scheme *sc, s7_int tag, s7_pointer setter) +{ +#if S7_DEBUGGING + if (!is_c_function(setter)) fprintf(stderr, "%s[%d]: %p is not a c_function\n", __func__, __LINE__, setter); +#endif + sc->c_object_types[tag]->setter = setter; +} + void s7_c_type_set_length(s7_scheme *sc, s7_int tag, s7_pointer (*length)(s7_scheme *sc, s7_pointer args)) { sc->c_object_types[tag]->length = length; @@ -41802,7 +42050,7 @@ static s7_pointer c_object_type_to_let(s { static s7_pointer name_symbol = NULL; if (!name_symbol) - name_symbol = s7_make_symbol(sc, "name"); + name_symbol = make_symbol(sc, "name"); return(g_local_inlet(sc, 4, name_symbol, c_object_scheme_name(sc, cobj), sc->setter_symbol, (c_object_set(sc, cobj) != fallback_set) ? sc->c_object_set_function : sc->F)); @@ -41820,9 +42068,9 @@ static void apply_c_object(s7_scheme *sc static bool op_c_object_a(s7_scheme *sc) { s7_pointer c; - c = symbol_to_value_checked(sc, car(sc->code)); + c = lookup_checked(sc, car(sc->code)); if (!is_c_object(c)) {sc->last_function = c; return(false);} - set_car(sc->t2_2, c_call(cdr(sc->code))(sc, cadr(sc->code))); + set_car(sc->t2_2, fx_call(sc, cdr(sc->code))); set_car(sc->t2_1, c); /* arg above might use sc->t2* */ sc->value = (*(c_object_ref(sc, c)))(sc, sc->t2_1); return(true); @@ -41886,7 +42134,7 @@ static void op_set_dilambda(s7_scheme *s sc->code = cdr(sc->code); sc->value = cadr(sc->code); if (is_symbol(sc->value)) - sc->value = symbol_to_value_checked(sc, sc->value); + sc->value = lookup_checked(sc, sc->value); } /* -------------------------------- dilambda? -------------------------------- */ @@ -43569,7 +43817,7 @@ static bool iterator_equal_1(s7_scheme * /* no morally-equal for lets etc?, can t_lets be (morally-)equal? yes: let_morally_equal * let case: (make-iterator (inlet 'integer? (lambda (f) #f))) - * hash case: (make-iterator (hash-table* 'a 1)) + * hash case: (make-iterator (hash-table 'a 1)) */ default: @@ -43685,6 +43933,7 @@ static bool real_equal(s7_scheme *sc, s7 static bool real_morally_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci) { + /* fprintf(stderr, "%s: %s %s\n", __func__, DISPLAY(x), DISPLAY(y)); */ #if WITH_GMP if (is_big_number(y)) return(big_equal(sc, set_plist_2(sc, x, y)) != sc->F); @@ -45506,7 +45755,7 @@ static s7_pointer object_to_list(s7_sche x = sc->w; sc->w = sc->nil; sc->temp8 = sc->nil; - free_cell(sc, iterator); /* 16-Nov-18 */ + /* free_cell(sc, iterator); */ /* 16-Nov-18 but then 18-Dec-18 got free cell that was iterator */ return(x); } return(sc->nil); @@ -45681,7 +45930,7 @@ static s7_pointer g_object_to_let(s7_sch { s7_pointer val; if (!sc->current_value_symbol) - sc->current_value_symbol = s7_make_symbol(sc, "current-value"); + sc->current_value_symbol = make_symbol(sc, "current-value"); val = s7_symbol_value(sc, obj); s7_varlet(sc, let, sc->current_value_symbol, val); s7_varlet(sc, let, sc->setter_symbol, g_setter(sc, args)); @@ -45714,8 +45963,8 @@ static s7_pointer g_object_to_let(s7_sch #else if (!sc->seed_symbol) { - sc->seed_symbol = s7_make_symbol(sc, "seed"); - sc->carry_symbol = s7_make_symbol(sc, "carry"); + sc->seed_symbol = make_symbol(sc, "seed"); + sc->carry_symbol = make_symbol(sc, "carry"); } return(g_local_inlet(sc, 8, sc->value_symbol, obj, sc->type_symbol, sc->is_random_state_symbol, @@ -45726,8 +45975,8 @@ static s7_pointer g_object_to_let(s7_sch case T_GOTO: if (!sc->active_symbol) { - sc->active_symbol = s7_make_symbol(sc, "active"); - sc->goto_symbol = s7_make_symbol(sc, "goto?"); + sc->active_symbol = make_symbol(sc, "active"); + sc->goto_symbol = make_symbol(sc, "goto?"); } return(g_local_inlet(sc, 6, sc->value_symbol, obj, sc->type_symbol, sc->goto_symbol, @@ -45740,9 +45989,9 @@ static s7_pointer g_object_to_let(s7_sch { s7_pointer let; if (!sc->dimensions_symbol) - sc->dimensions_symbol = s7_make_symbol(sc, "dimensions"); + sc->dimensions_symbol = make_symbol(sc, "dimensions"); if (!sc->position_symbol) - sc->position_symbol = s7_make_symbol(sc, "position"); + sc->position_symbol = make_symbol(sc, "position"); let = g_local_inlet(sc, 10, sc->value_symbol, obj, sc->type_symbol, (is_subvector(obj)) ? cons(sc, sc->is_subvector_symbol, s7_type_of(sc, subvector_vector(obj))) : s7_type_of(sc, obj), sc->length_symbol, s7_length(sc, obj), @@ -45762,8 +46011,8 @@ static s7_pointer g_object_to_let(s7_sch /* c_pointer_info can be a let and might have an object->let method (see c_object below) */ if (!sc->c_type_symbol) { - sc->c_type_symbol = s7_make_symbol(sc, "c-type"); - sc->info_symbol = s7_make_symbol(sc, "info"); + sc->c_type_symbol = make_symbol(sc, "c-type"); + sc->info_symbol = make_symbol(sc, "info"); } return(g_local_inlet(sc, 10, sc->value_symbol, obj, sc->type_symbol, sc->is_c_pointer_symbol, @@ -45779,8 +46028,8 @@ static s7_pointer g_object_to_let(s7_sch s7_pointer let, seq; if (!sc->at_end_symbol) { - sc->at_end_symbol = s7_make_symbol(sc, "at-end"); - sc->sequence_symbol = s7_make_symbol(sc, "sequence"); + sc->at_end_symbol = make_symbol(sc, "at-end"); + sc->sequence_symbol = make_symbol(sc, "sequence"); } seq = iterator_sequence(obj); let = g_local_inlet(sc, 8, sc->value_symbol, obj, @@ -45800,11 +46049,11 @@ static s7_pointer g_object_to_let(s7_sch (seq == sc->rootlet) || (is_c_object(seq)) || (is_hash_table(seq))) - s7_varlet(sc, let, s7_make_symbol(sc, "position"), s7_make_integer(sc, iterator_position(obj))); + s7_varlet(sc, let, make_symbol(sc, "position"), s7_make_integer(sc, iterator_position(obj))); else { if (is_pair(seq)) - s7_varlet(sc, let, s7_make_symbol(sc, "position"), iterator_current(obj)); + s7_varlet(sc, let, make_symbol(sc, "position"), iterator_current(obj)); } return(let); } @@ -45814,12 +46063,12 @@ static s7_pointer g_object_to_let(s7_sch s7_pointer let; if (!sc->entries_symbol) { - sc->entries_symbol = s7_make_symbol(sc, "entries"); - sc->locked_symbol = s7_make_symbol(sc, "locked"); - sc->weak_symbol = s7_make_symbol(sc, "weak"); + sc->entries_symbol = make_symbol(sc, "entries"); + sc->locked_symbol = make_symbol(sc, "locked"); + sc->weak_symbol = make_symbol(sc, "weak"); } if (!sc->function_symbol) - sc->function_symbol = s7_make_symbol(sc, "function"); + sc->function_symbol = make_symbol(sc, "function"); let = g_local_inlet(sc, 12, sc->value_symbol, obj, sc->type_symbol, sc->is_hash_table_symbol, sc->length_symbol, s7_length(sc, obj), @@ -45886,15 +46135,15 @@ static s7_pointer g_object_to_let(s7_sch s7_pointer let; if (!sc->open_symbol) { - sc->open_symbol = s7_make_symbol(sc, "open"); - sc->alias_symbol = s7_make_symbol(sc, "alias"); + sc->open_symbol = make_symbol(sc, "open"); + sc->alias_symbol = make_symbol(sc, "alias"); } if (!sc->function_symbol) - sc->function_symbol = s7_make_symbol(sc, "function"); + sc->function_symbol = make_symbol(sc, "function"); if (!sc->file_symbol) { - sc->file_symbol = s7_make_symbol(sc, "file"); - sc->line_symbol = s7_make_symbol(sc, "line"); + sc->file_symbol = make_symbol(sc, "file"); + sc->line_symbol = make_symbol(sc, "line"); } let = g_local_inlet(sc, 12, sc->value_symbol, obj, sc->type_symbol, sc->is_let_symbol, @@ -45944,16 +46193,16 @@ static s7_pointer g_object_to_let(s7_sch s7_pointer let, clet; if (!sc->class_symbol) { - sc->class_symbol = s7_make_symbol(sc, "class"); - sc->c_object_length_symbol = s7_make_symbol(sc, "c-object-length"); - sc->c_object_ref_symbol = s7_make_symbol(sc, "c-object-ref"); - sc->c_object_let_symbol = s7_make_symbol(sc, "c-object-let"); - sc->c_object_set_symbol = s7_make_symbol(sc, "c-object-set!"); - sc->c_object_copy_symbol = s7_make_symbol(sc, "c-object-copy"); - sc->c_object_fill_symbol = s7_make_symbol(sc, "c-object-fill!"); - sc->c_object_reverse_symbol = s7_make_symbol(sc, "c-object-reverse"); - sc->c_object_to_list_symbol = s7_make_symbol(sc, "c-object->list"); - sc->c_object_to_string_symbol = s7_make_symbol(sc, "c-object->string"); + sc->class_symbol = make_symbol(sc, "class"); + sc->c_object_length_symbol = make_symbol(sc, "c-object-length"); + sc->c_object_ref_symbol = make_symbol(sc, "c-object-ref"); + sc->c_object_let_symbol = make_symbol(sc, "c-object-let"); + sc->c_object_set_symbol = make_symbol(sc, "c-object-set!"); + sc->c_object_copy_symbol = make_symbol(sc, "c-object-copy"); + sc->c_object_fill_symbol = make_symbol(sc, "c-object-fill!"); + sc->c_object_reverse_symbol = make_symbol(sc, "c-object-reverse"); + sc->c_object_to_list_symbol = make_symbol(sc, "c-object->list"); + sc->c_object_to_string_symbol = make_symbol(sc, "c-object->string"); } clet = c_object_let(obj); let = g_local_inlet(sc, 10, sc->value_symbol, obj, @@ -46001,18 +46250,18 @@ static s7_pointer g_object_to_let(s7_sch { s7_pointer let; if (!sc->function_symbol) - sc->function_symbol = s7_make_symbol(sc, "function"); + sc->function_symbol = make_symbol(sc, "function"); if (!sc->file_symbol) { - sc->file_symbol = s7_make_symbol(sc, "file"); - sc->line_symbol = s7_make_symbol(sc, "line"); + sc->file_symbol = make_symbol(sc, "file"); + sc->line_symbol = make_symbol(sc, "line"); } if (!sc->data_symbol) { - sc->data_symbol = s7_make_symbol(sc, "data"); - sc->port_type_symbol = s7_make_symbol(sc, "port-type"); - sc->closed_symbol = s7_make_symbol(sc, "closed"); - if (!sc->position_symbol) sc->position_symbol = s7_make_symbol(sc, "position"); + sc->data_symbol = make_symbol(sc, "data"); + sc->port_type_symbol = make_symbol(sc, "port-type"); + sc->closed_symbol = make_symbol(sc, "closed"); + if (!sc->position_symbol) sc->position_symbol = make_symbol(sc, "position"); } let = g_local_inlet(sc, 10, sc->value_symbol, obj, sc->type_symbol, (is_input_port(obj)) ? sc->is_input_port_symbol : sc->is_output_port_symbol, @@ -46054,11 +46303,11 @@ static s7_pointer g_object_to_let(s7_sch s7_int gc_loc; if (!sc->file_symbol) { - sc->file_symbol = s7_make_symbol(sc, "file"); - sc->line_symbol = s7_make_symbol(sc, "line"); + sc->file_symbol = make_symbol(sc, "file"); + sc->line_symbol = make_symbol(sc, "line"); } if (!sc->source_symbol) - sc->source_symbol = s7_make_symbol(sc, "source"); + sc->source_symbol = make_symbol(sc, "source"); let = g_local_inlet(sc, 8, sc->value_symbol, obj, sc->type_symbol, (is_t_procedure(obj)) ? sc->is_procedure_symbol : sc->is_macro_symbol, sc->arity_symbol, s7_arity(sc, obj), @@ -46544,14 +46793,38 @@ s7_pointer s7_history(s7_scheme *sc) bool s7_history_enabled(s7_scheme *sc) { - return(sc->history_enabled); +#if WITH_HISTORY + return(sc->cur_code != sc->history_sink); +#else + return(false); +#endif } bool s7_set_history_enabled(s7_scheme *sc, bool enabled) { - sc->history_enabled = enabled; +#if WITH_HISTORY + if (enabled) + sc->cur_code = (sc->using_history1) ? sc->eval_history1 : sc->eval_history2; + else sc->cur_code = sc->history_sink; return(enabled); +#else + return(false); +#endif +} + +#if WITH_HISTORY +static s7_pointer history_cons(s7_scheme *sc, s7_pointer code, s7_pointer args) +{ + s7_pointer p; + p = car(sc->history_pairs); + sc->history_pairs = cdr(sc->history_pairs); + set_car(p, code); + set_cdr(p, args); + return(p); } +#else +#define history_cons(Sc, Code, Args) Code +#endif /* -------- error handlers -------- */ @@ -47065,7 +47338,7 @@ static void op_c_catch(s7_scheme *sc) if (!is_pair(f)) /* (catch #t ...) or (catch sym ...) */ { if (is_symbol(f)) - tag = symbol_to_value_checked(sc, f); + tag = lookup_checked(sc, f); else tag = f; } else tag = cadr(f); /* (catch 'sym ...) */ @@ -47226,7 +47499,6 @@ It has the additional local variables: e return(e); } - static s7_pointer active_catches(s7_scheme *sc) { int64_t i; @@ -47450,7 +47722,6 @@ static bool catch_1_function(s7_scheme * new_cell(sc, p, T_CLOSURE | T_COPY_ARGS); /* never a safe_closure, apparently */ closure_set_args(p, car(error_func)); closure_set_body(p, cdr(error_func)); - /* TODO: set one-form etc */ closure_set_setter(p, sc->F); closure_arity(p) = CLOSURE_ARITY_NOT_SET; closure_set_let(p, sc->temp4); @@ -47592,7 +47863,7 @@ static s7_pointer g_throw(s7_scheme *sc, { #define H_throw "(throw tag . info) is like (error ...) but it does not affect the owlet. \ It looks for an existing catch with a matching tag, and jumps to it if found. Otherwise it raises an error." - #define Q_throw s7_make_circular_signature(sc, 2, 3, sc->values_symbol, sc->is_symbol_symbol, sc->T) + #define Q_throw s7_make_circular_signature(sc, 1, 2, sc->values_symbol, sc->T) bool ignored_flag = false; int64_t i; @@ -47600,8 +47871,8 @@ It looks for an existing catch with a ma type = car(args); info = cdr(args); - /* look for a catcher */ + /* look for a catcher */ for (i = s7_stack_top(sc) - 1; i >= 3; i -= 4) { catch_function catcher; @@ -48064,7 +48335,7 @@ static s7_pointer g_error(s7_scheme *sc, #define H_error "(error type ...) signals an error. The 'type' can be used with catch to trap \ particular errors. If the error is not caught, s7 treats the second argument as a format control string, \ and applies it to the rest of the arguments." - #define Q_error s7_make_circular_signature(sc, 2, 3, sc->values_symbol, sc->is_symbol_symbol, sc->T) + #define Q_error s7_make_circular_signature(sc, 1, 2, sc->values_symbol, sc->T) if (is_not_null(args)) { @@ -48325,7 +48596,7 @@ static bool call_begin_hook(s7_scheme *s #endif set_outlet(sc->owlet, sc->envir); - sc->value = s7_make_symbol(sc, "begin-hook-interrupt"); + sc->value = make_symbol(sc, "begin-hook-interrupt"); /* otherwise the evaluator returns whatever random thing is in sc->value (normally #) * which makes debugging unnecessarily difficult. */ @@ -48421,9 +48692,7 @@ s7_pointer s7_apply_function(s7_scheme * T_Pos(car(p)); } #endif - if (sc->safety > NO_SAFETY) - set_current_code(sc, cons(sc, fnc, args)); - else set_current_code(sc, fnc); + set_current_code(sc, history_cons(sc, fnc, args)); if (is_c_function(fnc)) return(c_function_call(fnc)(sc, args)); @@ -48540,7 +48809,7 @@ static inline void fill_star_defaults(s7 s7_pointer defval; defval = df[i]; if (is_symbol(defval)) - set_car(par, symbol_to_value_checked(sc, defval)); + set_car(par, lookup_checked(sc, defval)); else { if (is_pair(defval)) @@ -48626,7 +48895,7 @@ static s7_pointer set_c_function_star_ar s7_pointer defval; defval = df[ki]; if (is_symbol(defval)) - set_car(kpar, symbol_to_value_checked(sc, defval)); + set_car(kpar, lookup_checked(sc, defval)); else { if (is_pair(defval)) @@ -48674,9 +48943,7 @@ static s7_pointer set_c_function_star_de s7_pointer s7_apply_function_star(s7_scheme *sc, s7_pointer fnc, s7_pointer args) { TRACK(sc); - if (sc->safety > NO_SAFETY) - set_current_code(sc, cons(sc, fnc, args)); - else set_current_code(sc, fnc); + set_current_code(sc, history_cons(sc, fnc, args)); if (is_c_function_star(fnc)) { @@ -48778,10 +49045,7 @@ s7_pointer s7_call(s7_scheme *sc, s7_poi { declare_jump_info(); TRACK(sc); - - if (sc->safety > NO_SAFETY) - set_current_code(sc, cons(sc, func, args)); - else set_current_code(sc, func); + set_current_code(sc, history_cons(sc, func, args)); if (is_c_function(func)) return(c_function_call(func)(sc, T_Pos(args))); /* no check for wrong-number-of-args -- is that reasonable? */ @@ -48987,20 +49251,10 @@ static bool aa_is_fx_safe(s7_pointer p) static bool opaaq_opaaq_is_fx_safe(s7_pointer p) { - if ((is_pair(cadr(p))) && (optimize_op(cadr(p)) == HOP_SAFE_C_AA) && - (is_pair(caddr(p))) && (optimize_op(caddr(p)) == HOP_SAFE_C_AA)) - { - s7_pointer arg11, arg12, arg21, arg22; - arg11 = cadr(cadr(p)); - arg12 = caddr(cadr(p)); - arg21 = cadr(caddr(p)); - arg22 = caddr(caddr(p)); - return(((!is_pair(arg11)) || (!is_fxa_op(optimize_op(arg11)))) && - ((!is_pair(arg12)) || (!is_fxa_op(optimize_op(arg12)))) && - ((!is_pair(arg21)) || (!is_fxa_op(optimize_op(arg21)))) && - ((!is_pair(arg22)) || (!is_fxa_op(optimize_op(arg22))))); - } - return(false); + return((is_pair(cadr(p))) && (optimize_op(cadr(p)) == HOP_SAFE_C_AA) && + (is_pair(caddr(p))) && (optimize_op(caddr(p)) == HOP_SAFE_C_AA) && + (aa_is_fx_safe(cadr(p))) && + (aa_is_fx_safe(caddr(p)))); } static bool aaa_is_fx_safe(s7_pointer p) @@ -49036,16 +49290,17 @@ static bool is_fx_safe(s7_scheme *sc, s7 return(aa_is_fx_safe(p) || opaaq_opaaq_is_fx_safe(p)); if (optimize_op(p) == HOP_SAFE_C_AAA) return(aaa_is_fx_safe(p)); -#if 0 - if ((optimize_op(p) == HOP_SAFE_C_opAAq) || - (optimize_op(p) == HOP_SAFE_C_S_opAAq) || - (optimize_op(p) == HOP_SAFE_C_opAAAq) || - (optimize_op(p) == HOP_SAFE_C_S_opAAAq) || - (optimize_op(p) == HOP_SAFE_C_FX) || - (optimize_op(p) == HOP_SAFE_C_ALL_CA)) - fprintf(stderr, "%s: %s\n", op_names[optimize_op(p)], DISPLAY(p)); - /* FX ALL_CA opAAq opAAAq S_opAAq S_opAAAq */ -#endif + if (optimize_op(p) == HOP_SAFE_C_opAAq) + return(aa_is_fx_safe(cadr(p))); + + if (optimize_op(p) == HOP_SAFE_C_FX) + { + s7_pointer e; + for (e = cdr(p); is_pair(e); e = cdr(e)) + if ((is_pair(car(e))) && (is_fxa_op(optimize_op(car(e))))) + break; + return(is_null(e)); + } } return(is_proper_quote(sc, p)); } @@ -49064,10 +49319,10 @@ static int32_t fx_count(s7_scheme *sc, s /* arg here is the full expression */ static s7_pointer fx_c(s7_scheme *sc, s7_pointer arg) {return(arg);} static s7_pointer fx_q(s7_scheme *sc, s7_pointer arg) {return(cadr(arg));} -static s7_pointer fx_unsafe_s(s7_scheme *sc, s7_pointer arg){return(symbol_to_value_checked(sc, arg));} -static s7_pointer fx_s(s7_scheme *sc, s7_pointer arg) {return(symbol_to_value_unchecked(sc, arg));} -static s7_pointer fx_c_c(s7_scheme *sc, s7_pointer arg) {return(c_call(arg)(sc, cdr(arg)));} -static s7_pointer fx_not_c_c(s7_scheme *sc, s7_pointer arg) {return(make_boolean(sc, is_false(sc, c_call(cadr(arg))(sc, cdadr(arg)))));} +static s7_pointer fx_unsafe_s(s7_scheme *sc, s7_pointer arg){return(lookup_checked(sc, arg));} +static s7_pointer fx_s(s7_scheme *sc, s7_pointer arg) {return(lookup(sc, arg));} +static s7_pointer fx_c_d(s7_scheme *sc, s7_pointer arg) {return(d_call(sc, arg));} +static s7_pointer fx_not_c_d(s7_scheme *sc, s7_pointer arg) {return(make_boolean(sc, is_false(sc, d_call(sc, cadr(arg)))));} #if S7_DEBUGGING static void check_let_slots(s7_scheme *sc, const char* func, s7_pointer expr, s7_pointer var) @@ -49098,7 +49353,7 @@ static s7_pointer fx_c_equal_s_ic(s7_sch s7_int y; s7_pointer val, args; args = cdr(arg); - val = symbol_to_value_unchecked(sc, car(args)); + val = lookup(sc, car(args)); y = integer(cadr(args)); if (is_integer(val)) return(make_boolean(sc, integer(val) == y)); @@ -49122,7 +49377,7 @@ static s7_pointer fx_c_equal_t_ic(s7_sch static s7_pointer fx_c_add_s1(s7_scheme *sc, s7_pointer arg) { s7_pointer x; - x = symbol_to_value_unchecked(sc, cadr(arg)); + x = lookup(sc, cadr(arg)); if (is_integer(x)) return(make_integer(sc, integer(x) + 1)); return(g_add_s1_1(sc, x, cdr(arg))); /* arg=(+ x 1) */ @@ -49154,7 +49409,7 @@ static s7_pointer fx_c_add_u1(s7_scheme static s7_pointer fx_c_sub_s1(s7_scheme *sc, s7_pointer arg) { s7_pointer x; - x = symbol_to_value_unchecked(sc, cadr(arg)); + x = lookup(sc, cadr(arg)); if (is_integer(x)) return(make_integer(sc, integer(x) - 1)); return(minus_c1(sc, x)); @@ -49163,7 +49418,7 @@ static s7_pointer fx_c_sub_s1(s7_scheme static s7_pointer fx_c_add_si(s7_scheme *sc, s7_pointer arg) { s7_pointer x; - x = symbol_to_value_unchecked(sc, cadr(arg)); + x = lookup(sc, cadr(arg)); if (is_integer(x)) return(make_integer(sc, integer(x) + integer(caddr(arg)))); return(add_p_pp(sc, x, caddr(arg))); @@ -49172,7 +49427,7 @@ static s7_pointer fx_c_add_si(s7_scheme static s7_pointer fx_c_sub_si(s7_scheme *sc, s7_pointer arg) { s7_pointer x; - x = symbol_to_value_unchecked(sc, cadr(arg)); + x = lookup(sc, cadr(arg)); if (is_integer(x)) return(make_integer(sc, integer(x) - integer(caddr(arg)))); return(subtract_p_pp(sc, x, caddr(arg))); @@ -49181,7 +49436,7 @@ static s7_pointer fx_c_sub_si(s7_scheme static s7_pointer fx_c_char_eq(s7_scheme *sc, s7_pointer arg) { s7_pointer c; - c = symbol_to_value_unchecked(sc, cadr(arg)); + c = lookup(sc, cadr(arg)); if (c == caddr(arg)) return(sc->T); if (s7_is_character(c)) @@ -49193,7 +49448,7 @@ static s7_pointer fx_is_eq_car_q(s7_sche { s7_pointer lst, a; a = cdr(arg); - lst = symbol_to_value_unchecked(sc, opt2_sym(a)); + lst = lookup(sc, opt2_sym(a)); if (is_pair(lst)) return(make_boolean(sc, car(lst) == opt3_any(a))); return(make_boolean(sc, s7_is_eq(g_car(sc, set_plist_1(sc, lst)), opt3_any(a)))); @@ -49203,7 +49458,7 @@ static s7_pointer fx_not_is_eq_car_q(s7_ { s7_pointer lst, a; a = opt2_pair(cdr(arg)); - lst = symbol_to_value_unchecked(sc, opt2_sym(a)); + lst = lookup(sc, opt2_sym(a)); if (is_pair(lst)) return(make_boolean(sc, car(lst) != opt3_any(a))); return(make_boolean(sc, !s7_is_eq(g_car(sc, set_plist_1(sc, lst)), opt3_any(a)))); @@ -49212,7 +49467,7 @@ static s7_pointer fx_not_is_eq_car_q(s7_ static s7_pointer fx_is_pair_cdr_s(s7_scheme *sc, s7_pointer arg) { s7_pointer p; - p = symbol_to_value_unchecked(sc, opt2_sym(cdr(arg))); + p = lookup(sc, opt2_sym(cdr(arg))); if (is_pair(p)) return(make_boolean(sc, is_pair(cdr(p)))); return(g_is_pair(sc, set_plist_1(sc, g_cdr(sc, set_plist_1(sc, p))))); @@ -49221,7 +49476,7 @@ static s7_pointer fx_is_pair_cdr_s(s7_sc static s7_pointer fx_is_pair_cddr_s(s7_scheme *sc, s7_pointer arg) { s7_pointer p; - p = symbol_to_value_unchecked(sc, opt2_sym(cdr(arg))); + p = lookup(sc, opt2_sym(cdr(arg))); if ((is_pair(p)) && (is_pair(cdr(p)))) return(make_boolean(sc, is_pair(cddr(p)))); return(g_is_pair(sc, set_plist_1(sc, g_cddr(sc, set_plist_1(sc, p))))); @@ -49230,7 +49485,7 @@ static s7_pointer fx_is_pair_cddr_s(s7_s static s7_pointer fx_is_null_cddr_s(s7_scheme *sc, s7_pointer arg) { s7_pointer p; - p = symbol_to_value_unchecked(sc, opt2_sym(cdr(arg))); + p = lookup(sc, opt2_sym(cdr(arg))); if ((is_pair(p)) && (is_pair(cdr(p)))) return(make_boolean(sc, is_null(cddr(p)))); return(g_is_null(sc, set_plist_1(sc, g_cddr(sc, set_plist_1(sc, p))))); @@ -49239,7 +49494,7 @@ static s7_pointer fx_is_null_cddr_s(s7_s static s7_pointer fx_is_null_cadr_s(s7_scheme *sc, s7_pointer arg) { s7_pointer p; - p = symbol_to_value_unchecked(sc, opt2_sym(cdr(arg))); + p = lookup(sc, opt2_sym(cdr(arg))); if ((is_pair(p)) && (is_pair(cdr(p)))) return(make_boolean(sc, is_null(cadr(p)))); return(g_is_null(sc, set_plist_1(sc, g_cadr(sc, set_plist_1(sc, p))))); @@ -49248,7 +49503,7 @@ static s7_pointer fx_is_null_cadr_s(s7_s static s7_pointer fx_is_symbol_cadr_s(s7_scheme *sc, s7_pointer arg) { s7_pointer p; - p = symbol_to_value_unchecked(sc, opt2_sym(cdr(arg))); + p = lookup(sc, opt2_sym(cdr(arg))); if ((is_pair(p)) && (is_pair(cdr(p)))) return(make_boolean(sc, is_symbol(cadr(p)))); return(g_is_symbol(sc, set_plist_1(sc, g_cadr(sc, set_plist_1(sc, p))))); @@ -49256,7 +49511,7 @@ static s7_pointer fx_is_symbol_cadr_s(s7 static s7_pointer fx_c_s(s7_scheme *sc, s7_pointer arg) { - set_car(sc->t1_1, symbol_to_value_unchecked(sc, cadr(arg))); + set_car(sc->t1_1, lookup(sc, cadr(arg))); return(c_call(arg)(sc, sc->t1_1)); } @@ -49267,20 +49522,20 @@ static s7_pointer fx_c_t(s7_scheme *sc, return(c_call(arg)(sc, sc->t1_1)); } -static s7_pointer direct_c_s(s7_scheme *sc, s7_pointer arg) +static s7_pointer fx_o_p_p_s(s7_scheme *sc, s7_pointer arg) { - return(((s7_p_p_t)opt2_direct_x_call(cdr(arg)))(sc, symbol_to_value_unchecked(sc, cadr(arg)))); + return(((s7_p_p_t)opt2_direct_x_call(cdr(arg)))(sc, lookup(sc, cadr(arg)))); } static s7_pointer fx_length_s(s7_scheme *sc, s7_pointer arg) { - return(s7_length(sc, symbol_to_value_unchecked(sc, cadr(arg)))); + return(s7_length(sc, lookup(sc, cadr(arg)))); } static s7_pointer fx_cdr_s(s7_scheme *sc, s7_pointer arg) { s7_pointer val; - val = symbol_to_value_unchecked(sc, cadr(arg)); + val = lookup(sc, cadr(arg)); return((is_pair(val)) ? cdr(val) : g_cdr(sc, set_plist_1(sc, val))); } @@ -49295,20 +49550,20 @@ static s7_pointer fx_cdr_t(s7_scheme *sc static s7_pointer fx_car_s(s7_scheme *sc, s7_pointer arg) { s7_pointer val; - val = symbol_to_value_unchecked(sc, cadr(arg)); + val = lookup(sc, cadr(arg)); return((is_pair(val)) ? car(val) : g_car(sc, set_plist_1(sc, val))); } static s7_pointer fx_cadr_s(s7_scheme *sc, s7_pointer arg) { s7_pointer val; - val = symbol_to_value_unchecked(sc, cadr(arg)); + val = lookup(sc, cadr(arg)); return(((is_pair(val)) && (is_pair(cdr(val)))) ? cadr(val) : g_cadr(sc, set_plist_1(sc, val))); } static s7_pointer fx_is_null_s(s7_scheme *sc, s7_pointer arg) { - return((is_null(symbol_to_value_unchecked(sc, cadr(arg)))) ? sc->T : sc->F); + return((is_null(lookup(sc, cadr(arg)))) ? sc->T : sc->F); } static s7_pointer fx_is_null_t(s7_scheme *sc, s7_pointer arg) @@ -49319,66 +49574,66 @@ static s7_pointer fx_is_null_t(s7_scheme static s7_pointer fx_is_symbol_s(s7_scheme *sc, s7_pointer arg) { - return((is_symbol(symbol_to_value_unchecked(sc, cadr(arg)))) ? sc->T : sc->F); + return((is_symbol(lookup(sc, cadr(arg)))) ? sc->T : sc->F); } static s7_pointer fx_is_type_s(s7_scheme *sc, s7_pointer arg) { - return(make_boolean(sc, (uint8_t)(opt3_con(cdr(arg))) == type(symbol_to_value_unchecked(sc, cadr(arg))))); + return(make_boolean(sc, (uint8_t)(opt3_con(cdr(arg))) == type(lookup(sc, cadr(arg))))); } static s7_pointer fx_is_integer_s(s7_scheme *sc, s7_pointer arg) { #if WITH_GMP - return((s7_is_integer(symbol_to_value_unchecked(sc, cadr(arg)))) ? sc->T : sc->F); + return((s7_is_integer(lookup(sc, cadr(arg)))) ? sc->T : sc->F); #else - return((is_integer(symbol_to_value_unchecked(sc, cadr(arg)))) ? sc->T : sc->F); + return((is_integer(lookup(sc, cadr(arg)))) ? sc->T : sc->F); #endif } static s7_pointer fx_is_string_s(s7_scheme *sc, s7_pointer arg) { - return((is_string(symbol_to_value_unchecked(sc, cadr(arg)))) ? sc->T : sc->F); + return((is_string(lookup(sc, cadr(arg)))) ? sc->T : sc->F); } static s7_pointer fx_is_procedure_s(s7_scheme *sc, s7_pointer arg) { - return((is_procedure(symbol_to_value_unchecked(sc, cadr(arg)))) ? sc->T : sc->F); + return((is_procedure(lookup(sc, cadr(arg)))) ? sc->T : sc->F); } static s7_pointer fx_is_pair_s(s7_scheme *sc, s7_pointer arg) { - return((is_pair(symbol_to_value_unchecked(sc, cadr(arg)))) ? sc->T : sc->F); + return((is_pair(lookup(sc, cadr(arg)))) ? sc->T : sc->F); } static s7_pointer fx_is_keyword_s(s7_scheme *sc, s7_pointer arg) { - return((is_keyword(symbol_to_value_unchecked(sc, cadr(arg)))) ? sc->T : sc->F); + return((is_keyword(lookup(sc, cadr(arg)))) ? sc->T : sc->F); } static s7_pointer fx_is_vector_s(s7_scheme *sc, s7_pointer arg) { - return((is_any_vector(symbol_to_value_unchecked(sc, cadr(arg)))) ? sc->T : sc->F); + return((is_any_vector(lookup(sc, cadr(arg)))) ? sc->T : sc->F); } static s7_pointer fx_is_proper_list_s(s7_scheme *sc, s7_pointer arg) { - return((s7_is_proper_list(sc, symbol_to_value_unchecked(sc, cadr(arg)))) ? sc->T : sc->F); + return((s7_is_proper_list(sc, lookup(sc, cadr(arg)))) ? sc->T : sc->F); } static s7_pointer fx_not_s(s7_scheme *sc, s7_pointer arg) { - return(make_boolean(sc, is_false(sc, symbol_to_value_unchecked(sc, cadr(arg))))); + return(make_boolean(sc, is_false(sc, lookup(sc, cadr(arg))))); } static s7_pointer fx_not_is_pair_s(s7_scheme *sc, s7_pointer arg) { - return((is_pair(symbol_to_value_unchecked(sc, opt3_sym(arg)))) ? sc->F : sc->T); + return((is_pair(lookup(sc, opt3_sym(arg)))) ? sc->F : sc->T); } static s7_pointer fx_c_sc(s7_scheme *sc, s7_pointer arg) { - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(arg))); + set_car(sc->t2_1, lookup(sc, cadr(arg))); set_car(sc->t2_2, opt2_con(cdr(arg))); return(c_call(arg)(sc, sc->t2_1)); } @@ -49394,86 +49649,86 @@ static s7_pointer fx_c_tc(s7_scheme *sc, static s7_pointer fx_c_cs(s7_scheme *sc, s7_pointer arg) { set_car(sc->t2_1, opt1_con(cdr(arg))); /* cadr(arg) or cadadr */ - set_car(sc->t2_2, symbol_to_value_unchecked(sc, caddr(arg))); + set_car(sc->t2_2, lookup(sc, caddr(arg))); return(c_call(arg)(sc, sc->t2_1)); } static s7_pointer fx_c_ss(s7_scheme *sc, s7_pointer arg) { - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(arg))); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, opt2_sym(cdr(arg)))); + set_car(sc->t2_1, lookup(sc, cadr(arg))); + set_car(sc->t2_2, lookup(sc, opt2_sym(cdr(arg)))); return(c_call(arg)(sc, sc->t2_1)); } static s7_pointer fx_cons_ss(s7_scheme *sc, s7_pointer arg) { - return(cons(sc, symbol_to_value_unchecked(sc, cadr(arg)), symbol_to_value_unchecked(sc, opt2_sym(cdr(arg))))); + return(cons(sc, lookup(sc, cadr(arg)), lookup(sc, opt2_sym(cdr(arg))))); } static s7_pointer fx_add_ss(s7_scheme *sc, s7_pointer arg) { - return(add_p_pp(sc, symbol_to_value_unchecked(sc, cadr(arg)), symbol_to_value_unchecked(sc, opt2_sym(cdr(arg))))); + return(add_p_pp(sc, lookup(sc, cadr(arg)), lookup(sc, opt2_sym(cdr(arg))))); } static s7_pointer fx_add_ts(s7_scheme *sc, s7_pointer arg) { - return(add_p_pp(sc, slot_value(let_slots(sc->envir)), symbol_to_value_unchecked(sc, opt2_sym(cdr(arg))))); + return(add_p_pp(sc, slot_value(let_slots(sc->envir)), lookup(sc, opt2_sym(cdr(arg))))); } static s7_pointer fx_subtract_ss(s7_scheme *sc, s7_pointer arg) { - return(subtract_p_pp(sc, symbol_to_value_unchecked(sc, cadr(arg)), symbol_to_value_unchecked(sc, opt2_sym(cdr(arg))))); + return(subtract_p_pp(sc, lookup(sc, cadr(arg)), lookup(sc, opt2_sym(cdr(arg))))); } #if (!WITH_GMP) static s7_pointer fx_multiply_ss(s7_scheme *sc, s7_pointer arg) { - return(multiply_p_pp(sc, symbol_to_value_unchecked(sc, cadr(arg)), symbol_to_value_unchecked(sc, opt2_sym(cdr(arg))))); + return(multiply_p_pp(sc, lookup(sc, cadr(arg)), lookup(sc, opt2_sym(cdr(arg))))); } static s7_pointer fx_geq_ss(s7_scheme *sc, s7_pointer arg) { - return(geq_p_pp(sc, symbol_to_value_unchecked(sc, cadr(arg)), symbol_to_value_unchecked(sc, opt2_sym(cdr(arg))))); + return(geq_p_pp(sc, lookup(sc, cadr(arg)), lookup(sc, opt2_sym(cdr(arg))))); } static s7_pointer fx_geq_ts(s7_scheme *sc, s7_pointer arg) { check_let_slots(sc, __func__, arg, cadr(arg)); - return(geq_p_pp(sc, slot_value(let_slots(sc->envir)), symbol_to_value_unchecked(sc, opt2_sym(cdr(arg))))); + return(geq_p_pp(sc, slot_value(let_slots(sc->envir)), lookup(sc, opt2_sym(cdr(arg))))); } static s7_pointer fx_gt_ss(s7_scheme *sc, s7_pointer arg) { - return(gt_p_pp(sc, symbol_to_value_unchecked(sc, cadr(arg)), symbol_to_value_unchecked(sc, opt2_sym(cdr(arg))))); + return(gt_p_pp(sc, lookup(sc, cadr(arg)), lookup(sc, opt2_sym(cdr(arg))))); } static s7_pointer fx_leq_ss(s7_scheme *sc, s7_pointer arg) { - return(leq_p_pp(sc, symbol_to_value_unchecked(sc, cadr(arg)), symbol_to_value_unchecked(sc, opt2_sym(cdr(arg))))); + return(leq_p_pp(sc, lookup(sc, cadr(arg)), lookup(sc, opt2_sym(cdr(arg))))); } static s7_pointer fx_lt_ss(s7_scheme *sc, s7_pointer arg) { - return(lt_p_pp(sc, symbol_to_value_unchecked(sc, cadr(arg)), symbol_to_value_unchecked(sc, opt2_sym(cdr(arg))))); + return(lt_p_pp(sc, lookup(sc, cadr(arg)), lookup(sc, opt2_sym(cdr(arg))))); } static s7_pointer fx_equal_ss(s7_scheme *sc, s7_pointer arg) { - return(c_equal_2(sc, symbol_to_value_unchecked(sc, cadr(arg)), symbol_to_value_unchecked(sc, opt2_sym(cdr(arg))))); + return(c_equal_2(sc, lookup(sc, cadr(arg)), lookup(sc, opt2_sym(cdr(arg))))); } static s7_pointer fx_equal_ts(s7_scheme *sc, s7_pointer arg) { check_let_slots(sc, __func__, arg, cadr(arg)); - return(c_equal_2(sc, slot_value(let_slots(sc->envir)), symbol_to_value_unchecked(sc, opt2_sym(cdr(arg))))); + return(c_equal_2(sc, slot_value(let_slots(sc->envir)), lookup(sc, opt2_sym(cdr(arg))))); } #endif static s7_pointer fx_is_eq_ss(s7_scheme *sc, s7_pointer arg) { s7_pointer x, y; - x = symbol_to_value_unchecked(sc, cadr(arg)); - y = symbol_to_value_unchecked(sc, opt2_sym(cdr(arg))); + x = lookup(sc, cadr(arg)); + y = lookup(sc, opt2_sym(cdr(arg))); return(make_boolean(sc, (x == y) || ((is_unspecified(x)) && (is_unspecified(y))))); } @@ -49488,7 +49743,7 @@ static s7_pointer x_c_hash_table_ref_ss( static s7_pointer fx_c_hash_table_ref_ss(s7_scheme *sc, s7_pointer arg) { - return(x_c_hash_table_ref_ss(sc, symbol_to_value_unchecked(sc, cadr(arg)), symbol_to_value_unchecked(sc, opt2_sym(cdr(arg))))); + return(x_c_hash_table_ref_ss(sc, lookup(sc, cadr(arg)), lookup(sc, opt2_sym(cdr(arg))))); } static s7_pointer fx_c_hash_table_ref_car(s7_scheme *sc, s7_pointer arg) @@ -49496,8 +49751,8 @@ static s7_pointer fx_c_hash_table_ref_ca s7_pointer table, lst; hash_entry_t *x; - table = symbol_to_value_unchecked(sc, cadr(arg)); - lst = symbol_to_value_unchecked(sc, opt3_sym(cdr(arg))); + table = lookup(sc, cadr(arg)); + lst = lookup(sc, opt3_sym(cdr(arg))); if (!is_pair(lst)) return(simple_wrong_type_argument(sc, sc->car_symbol, lst, T_PAIR)); @@ -49516,7 +49771,7 @@ static s7_pointer fx_c_lint_let_ref(s7_s static s7_pointer fx_memq_sq_2(s7_scheme *sc, s7_pointer arg) { s7_pointer p, obj; - obj = symbol_to_value_unchecked(sc, cadr(arg)); + obj = lookup(sc, cadr(arg)); p = opt2_con(cdr(arg)); if (obj == car(p)) return(p); if (obj == cadr(p)) return(cdr(p)); @@ -49532,23 +49787,23 @@ static s7_pointer fx_c_cq(s7_scheme *sc, static s7_pointer fx_c_sss(s7_scheme *sc, s7_pointer arg) { - set_car(sc->t3_1, symbol_to_value_unchecked(sc, cadr(arg))); - set_car(sc->t3_2, symbol_to_value_unchecked(sc, opt1_sym(cdr(arg)))); /* caddr(arg) */ - set_car(sc->t3_3, symbol_to_value_unchecked(sc, opt2_sym(cdr(arg)))); /* cadddr(arg) */ + set_car(sc->t3_1, lookup(sc, cadr(arg))); + set_car(sc->t3_2, lookup(sc, opt1_sym(cdr(arg)))); /* caddr(arg) */ + set_car(sc->t3_3, lookup(sc, opt2_sym(cdr(arg)))); /* cadddr(arg) */ return(c_call(arg)(sc, sc->t3_1)); } static s7_pointer fx_c_scs(s7_scheme *sc, s7_pointer arg) { - set_car(sc->t3_1, symbol_to_value_unchecked(sc, cadr(arg))); - set_car(sc->t3_3, symbol_to_value_unchecked(sc, opt2_sym(cdr(arg)))); /* cadddr(arg) */ + set_car(sc->t3_1, lookup(sc, cadr(arg))); + set_car(sc->t3_3, lookup(sc, opt2_sym(cdr(arg)))); /* cadddr(arg) */ set_car(sc->t3_2, opt1_con(cdr(arg))); /* caddr(arg) */ return(c_call(arg)(sc, sc->t3_1)); } static s7_pointer fx_c_scc(s7_scheme *sc, s7_pointer arg) { - set_car(sc->t3_1, symbol_to_value_unchecked(sc, cadr(arg))); + set_car(sc->t3_1, lookup(sc, cadr(arg))); set_car(sc->t3_2, opt1_con(cdr(arg))); /* caddr(arg) */ set_car(sc->t3_3, opt2_con(cdr(arg))); /* cadddr(arg) */ return(c_call(arg)(sc, sc->t3_1)); @@ -49556,15 +49811,15 @@ static s7_pointer fx_c_scc(s7_scheme *sc static s7_pointer fx_c_css(s7_scheme *sc, s7_pointer arg) { - set_car(sc->t3_2, symbol_to_value_unchecked(sc, opt1_sym(cdr(arg)))); /* caddr(arg) */ - set_car(sc->t3_3, symbol_to_value_unchecked(sc, opt2_sym(cdr(arg)))); /* cadddr(arg) */ + set_car(sc->t3_2, lookup(sc, opt1_sym(cdr(arg)))); /* caddr(arg) */ + set_car(sc->t3_3, lookup(sc, opt2_sym(cdr(arg)))); /* cadddr(arg) */ set_car(sc->t3_1, cadr(arg)); return(c_call(arg)(sc, sc->t3_1)); } static s7_pointer fx_c_csc(s7_scheme *sc, s7_pointer arg) { - set_car(sc->t3_2, symbol_to_value_unchecked(sc, opt1_sym(cdr(arg)))); /* caddr(arg) */ + set_car(sc->t3_2, lookup(sc, opt1_sym(cdr(arg)))); /* caddr(arg) */ set_car(sc->t3_1, cadr(arg)); set_car(sc->t3_3, opt2_con(cdr(arg))); /* cadddr(arg) */ return(c_call(arg)(sc, sc->t3_1)); @@ -49572,7 +49827,7 @@ static s7_pointer fx_c_csc(s7_scheme *sc static s7_pointer fx_c_ccs(s7_scheme *sc, s7_pointer arg) { - set_car(sc->t3_3, symbol_to_value_unchecked(sc, opt1_sym(cdr(arg)))); /* cadddr */ + set_car(sc->t3_3, lookup(sc, opt1_sym(cdr(arg)))); /* cadddr */ set_car(sc->t3_1, cadr(arg)); set_car(sc->t3_2, opt2_con(cdr(arg))); /* caddr(arg) */ return(c_call(arg)(sc, sc->t3_1)); @@ -49580,8 +49835,8 @@ static s7_pointer fx_c_ccs(s7_scheme *sc static s7_pointer fx_c_ssc(s7_scheme *sc, s7_pointer arg) { - set_car(sc->t3_1, symbol_to_value_unchecked(sc, cadr(arg))); - set_car(sc->t3_2, symbol_to_value_unchecked(sc, opt1_sym(cdr(arg)))); /* caddr(arg) */ + set_car(sc->t3_1, lookup(sc, cadr(arg))); + set_car(sc->t3_2, lookup(sc, opt1_sym(cdr(arg)))); /* caddr(arg) */ set_car(sc->t3_3, opt2_con(cdr(arg))); /* cadddr(arg) */ return(c_call(arg)(sc, sc->t3_1)); } @@ -49590,7 +49845,7 @@ static s7_pointer fx_c_opdq(s7_scheme *s { s7_pointer largs; largs = cadr(arg); - set_car(sc->t1_1, c_call(largs)(sc, cdr(largs))); + set_car(sc->t1_1, d_call(sc, largs)); return(c_call(arg)(sc, sc->t1_1)); } @@ -49598,8 +49853,8 @@ static s7_pointer fx_c_s_opdq(s7_scheme { s7_pointer largs; largs = caddr(arg); - set_car(sc->t2_2, c_call(largs)(sc, cdr(largs))); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(arg))); + set_car(sc->t2_2, d_call(sc, largs)); + set_car(sc->t2_1, lookup(sc, cadr(arg))); return(c_call(arg)(sc, sc->t2_1)); } @@ -49607,7 +49862,7 @@ static s7_pointer fx_c_c_opdq(s7_scheme { s7_pointer largs; largs = caddr(arg); - set_car(sc->t2_2, c_call(largs)(sc, cdr(largs))); + set_car(sc->t2_2, d_call(sc, largs)); set_car(sc->t2_1, cadr(arg)); return(c_call(arg)(sc, sc->t2_1)); } @@ -49616,8 +49871,8 @@ static s7_pointer fx_c_opdq_s(s7_scheme { s7_pointer largs; largs = cadr(arg); - set_car(sc->t2_1, c_call(largs)(sc, cdr(largs))); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, caddr(arg))); + set_car(sc->t2_1, d_call(sc, largs)); + set_car(sc->t2_2, lookup(sc, caddr(arg))); return(c_call(arg)(sc, sc->t2_1)); } @@ -49625,7 +49880,7 @@ static s7_pointer fx_c_opdq_c(s7_scheme { s7_pointer largs; largs = cadr(arg); - set_car(sc->t2_1, c_call(largs)(sc, cdr(largs))); + set_car(sc->t2_1, d_call(sc, largs)); set_car(sc->t2_2, caddr(arg)); return(c_call(arg)(sc, sc->t2_1)); } @@ -49636,9 +49891,9 @@ static s7_pointer fx_c_opdq_opdq(s7_sche int32_t tx; tx = next_tx(sc); largs = cadr(arg); - sc->t_temps[tx] = c_call(largs)(sc, cdr(largs)); + sc->t_temps[tx] = d_call(sc, largs); largs = caddr(arg); - set_car(sc->t2_2, c_call(largs)(sc, cdr(largs))); + set_car(sc->t2_2, d_call(sc, largs)); set_car(sc->t2_1, sc->t_temps[tx]); return(c_call(arg)(sc, sc->t2_1)); } @@ -49647,7 +49902,7 @@ static s7_pointer fx_c_opsq(s7_scheme *s { s7_pointer largs; largs = cadr(arg); - set_car(sc->t1_1, symbol_to_value_unchecked(sc, cadr(largs))); + set_car(sc->t1_1, lookup(sc, cadr(largs))); set_car(sc->t1_1, c_call(largs)(sc, sc->t1_1)); return(c_call(arg)(sc, sc->t1_1)); } @@ -49655,7 +49910,7 @@ static s7_pointer fx_c_opsq(s7_scheme *s static s7_pointer fx_c_car_s(s7_scheme *sc, s7_pointer arg) { s7_pointer val; - val = symbol_to_value_unchecked(sc, opt2_sym(cdr(arg))); + val = lookup(sc, opt2_sym(cdr(arg))); set_car(sc->t1_1, (is_pair(val)) ? car(val) : g_car(sc, set_plist_1(sc, val))); return(c_call(arg)(sc, sc->t1_1)); } @@ -49663,7 +49918,7 @@ static s7_pointer fx_c_car_s(s7_scheme * static s7_pointer fx_c_cdr_s(s7_scheme *sc, s7_pointer arg) { s7_pointer val; - val = symbol_to_value_unchecked(sc, opt2_sym(cdr(arg))); + val = lookup(sc, opt2_sym(cdr(arg))); set_car(sc->t1_1, (is_pair(val)) ? cdr(val) : g_cdr(sc, set_plist_1(sc, val))); return(c_call(arg)(sc, sc->t1_1)); } @@ -49671,7 +49926,7 @@ static s7_pointer fx_c_cdr_s(s7_scheme * static s7_pointer fx_c_is_type_opsq(s7_scheme *sc, s7_pointer arg) { s7_pointer val; - val = symbol_to_value_unchecked(sc, opt2_sym(cdr(arg))); + val = lookup(sc, opt2_sym(cdr(arg))); set_car(sc->t1_1, val); return(make_boolean(sc, (uint8_t)(opt3_con(cdr(arg))) == type(c_call(cadr(arg))(sc, sc->t1_1)))); } @@ -49679,7 +49934,7 @@ static s7_pointer fx_c_is_type_opsq(s7_s static s7_pointer fx_c_is_type_car_s(s7_scheme *sc, s7_pointer arg) { s7_pointer val; - val = symbol_to_value_unchecked(sc, opt2_sym(cdr(arg))); + val = lookup(sc, opt2_sym(cdr(arg))); if (is_pair(val)) return(make_boolean(sc, (uint8_t)(opt3_con(cdr(arg))) == type(car(val)))); return(make_boolean(sc, (uint8_t)(opt3_con(cdr(arg))) == type(g_car(sc, set_plist_1(sc, val))))); @@ -49688,7 +49943,7 @@ static s7_pointer fx_c_is_type_car_s(s7_ static s7_pointer fx_c_weak1_type(s7_scheme *sc, s7_pointer arg) { s7_pointer val; - val = symbol_to_value_unchecked(sc, opt2_sym(cdr(arg))); + val = lookup(sc, opt2_sym(cdr(arg))); if (!is_c_pointer(val)) return(method_or_bust(sc, val, sc->c_pointer_weak1_symbol, cdadr(arg), T_C_POINTER, 1)); return(make_boolean(sc, (uint8_t)(opt3_con(cdr(arg))) == type(c_pointer_weak1(val)))); @@ -49698,7 +49953,7 @@ static s7_pointer fx_not_opsq(s7_scheme { s7_pointer largs; largs = cadr(arg); - set_car(sc->t1_1, symbol_to_value_unchecked(sc, cadr(largs))); + set_car(sc->t1_1, lookup(sc, cadr(largs))); if (c_call(largs)(sc, sc->t1_1) == sc->F) return(sc->T); return(sc->F); } @@ -49707,8 +49962,8 @@ static s7_pointer fx_c_opssq(s7_scheme * { s7_pointer largs; largs = cadr(arg); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(largs))); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, opt2_sym(cdr(largs)))); /* caddr(largs) */ + set_car(sc->t2_1, lookup(sc, cadr(largs))); + set_car(sc->t2_2, lookup(sc, opt2_sym(cdr(largs)))); /* caddr(largs) */ set_car(sc->t1_1, c_call(largs)(sc, sc->t2_1)); return(c_call(arg)(sc, sc->t1_1)); } @@ -49717,7 +49972,7 @@ static s7_pointer fx_c_opstq(s7_scheme * { s7_pointer largs; largs = cadr(arg); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(largs))); + set_car(sc->t2_1, lookup(sc, cadr(largs))); check_let_slots(sc, __func__, arg, caddr(largs)); set_car(sc->t2_2, slot_value(let_slots(sc->envir))); set_car(sc->t1_1, c_call(largs)(sc, sc->t2_1)); @@ -49728,8 +49983,8 @@ static s7_pointer fx_not_opssq(s7_scheme { s7_pointer largs; largs = cadr(arg); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(largs))); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, opt2_sym(cdr(largs)))); + set_car(sc->t2_1, lookup(sc, cadr(largs))); + set_car(sc->t2_2, lookup(sc, opt2_sym(cdr(largs)))); if (c_call(largs)(sc, sc->t2_1) == sc->F) return(sc->T); return(sc->F); } @@ -49738,7 +49993,7 @@ static s7_pointer fx_c_opscq(s7_scheme * { s7_pointer largs; largs = cadr(arg); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(largs))); + set_car(sc->t2_1, lookup(sc, cadr(largs))); set_car(sc->t2_2, opt2_con(cdr(largs))); set_car(sc->t1_1, c_call(largs)(sc, sc->t2_1)); return(c_call(arg)(sc, sc->t1_1)); @@ -49748,7 +50003,7 @@ static s7_pointer fx_c_opcsq(s7_scheme * { s7_pointer largs; largs = cadr(arg); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, caddr(largs))); + set_car(sc->t2_2, lookup(sc, caddr(largs))); set_car(sc->t2_1, opt1_con(cdr(largs))); /* cadr(largs) or cadadr */ set_car(sc->t1_1, c_call(largs)(sc, sc->t2_1)); return(c_call(arg)(sc, sc->t1_1)); @@ -49758,7 +50013,7 @@ static s7_pointer fx_c_opcsq_c(s7_scheme { s7_pointer largs; largs = cadr(arg); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, caddr(largs))); + set_car(sc->t2_2, lookup(sc, caddr(largs))); set_car(sc->t2_1, opt1_con(cdr(largs))); /* cadr(largs) or cadadr */ set_car(sc->t2_1, c_call(largs)(sc, sc->t2_1)); set_car(sc->t2_2, caddr(arg)); @@ -49769,10 +50024,10 @@ static s7_pointer fx_c_opcsq_s(s7_scheme { s7_pointer largs; largs = cadr(arg); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, caddr(largs))); + set_car(sc->t2_2, lookup(sc, caddr(largs))); set_car(sc->t2_1, opt1_con(cdr(largs))); /* cadr(largs) or cadadr */ set_car(sc->t2_1, c_call(largs)(sc, sc->t2_1)); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, caddr(arg))); + set_car(sc->t2_2, lookup(sc, caddr(arg))); return(c_call(arg)(sc, sc->t2_1)); } @@ -49780,10 +50035,10 @@ static s7_pointer fx_c_opssq_s(s7_scheme { s7_pointer largs; largs = cadr(arg); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(largs))); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, opt2_sym(cdr(largs)))); + set_car(sc->t2_1, lookup(sc, cadr(largs))); + set_car(sc->t2_2, lookup(sc, opt2_sym(cdr(largs)))); set_car(sc->t2_1, c_call(largs)(sc, sc->t2_1)); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, caddr(arg))); + set_car(sc->t2_2, lookup(sc, caddr(arg))); return(c_call(arg)(sc, sc->t2_1)); } @@ -49791,10 +50046,10 @@ static s7_pointer fx_c_opscq_s(s7_scheme { s7_pointer largs; largs = cadr(arg); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(largs))); + set_car(sc->t2_1, lookup(sc, cadr(largs))); set_car(sc->t2_2, opt2_con(cdr(largs))); set_car(sc->t2_1, c_call(largs)(sc, sc->t2_1)); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, caddr(arg))); + set_car(sc->t2_2, lookup(sc, caddr(arg))); return(c_call(arg)(sc, sc->t2_1)); } @@ -49802,7 +50057,7 @@ static s7_pointer fx_c_opscq_c(s7_scheme { s7_pointer largs; largs = cadr(arg); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(largs))); + set_car(sc->t2_1, lookup(sc, cadr(largs))); set_car(sc->t2_2, opt2_con(cdr(largs))); set_car(sc->t2_1, c_call(largs)(sc, sc->t2_1)); set_car(sc->t2_2, caddr(arg)); @@ -49813,8 +50068,8 @@ static s7_pointer fx_c_opssq_c(s7_scheme { s7_pointer largs; largs = cadr(arg); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(largs))); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, opt2_sym(cdr(largs)))); + set_car(sc->t2_1, lookup(sc, cadr(largs))); + set_car(sc->t2_2, lookup(sc, opt2_sym(cdr(largs)))); set_car(sc->t2_1, c_call(largs)(sc, sc->t2_1)); set_car(sc->t2_2, caddr(arg)); return(c_call(arg)(sc, sc->t2_1)); @@ -49823,9 +50078,9 @@ static s7_pointer fx_c_opssq_c(s7_scheme static s7_pointer fx_c_car_s_s(s7_scheme *sc, s7_pointer arg) { s7_pointer val; - val = symbol_to_value_unchecked(sc, opt1_sym(cdr(arg))); /* cadadr(arg)); */ + val = lookup(sc, opt1_sym(cdr(arg))); /* cadadr(arg)); */ set_car(sc->t2_1, (is_pair(val)) ? car(val) : g_car(sc, set_plist_1(sc, val))); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, caddr(arg))); + set_car(sc->t2_2, lookup(sc, caddr(arg))); return(c_call(arg)(sc, sc->t2_1)); } @@ -49833,32 +50088,24 @@ static s7_pointer fx_c_opsq_s(s7_scheme { s7_pointer largs; largs = cadr(arg); - set_car(sc->t1_1, symbol_to_value_unchecked(sc, cadr(largs))); + set_car(sc->t1_1, lookup(sc, cadr(largs))); set_car(sc->t2_1, c_call(largs)(sc, sc->t1_1)); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, caddr(arg))); + set_car(sc->t2_2, lookup(sc, caddr(arg))); return(c_call(arg)(sc, sc->t2_1)); } static s7_pointer fx_c_opsq_cs(s7_scheme *sc, s7_pointer arg) { -#if 0 - s7_pointer largs; - largs = cadr(arg); -#endif - set_car(sc->t1_1, symbol_to_value_unchecked(sc, opt3_sym(cdr(arg)))); /* cadadr(arg); */ + set_car(sc->t1_1, lookup(sc, opt3_sym(cdr(arg)))); /* cadadr(arg); */ set_car(sc->t3_1, c_call(cadr(arg))(sc, sc->t1_1)); set_car(sc->t3_2, opt1_con(cdr(arg))); /* caddr(arg) or cadr(caddr(arg)) */ - set_car(sc->t3_3, symbol_to_value_unchecked(sc, opt2_sym(cdr(arg)))); /* cadddr(arg); */ + set_car(sc->t3_3, lookup(sc, opt2_sym(cdr(arg)))); /* cadddr(arg); */ return(c_call(arg)(sc, sc->t3_1)); } static s7_pointer fx_c_opsq_c(s7_scheme *sc, s7_pointer arg) { -#if 0 - s7_pointer largs; - largs = cadr(arg); -#endif - set_car(sc->t1_1, symbol_to_value_unchecked(sc, opt1_con(cdr(arg)))); + set_car(sc->t1_1, lookup(sc, opt1_con(cdr(arg)))); set_car(sc->t2_1, c_call(cadr(arg))(sc, sc->t1_1)); set_car(sc->t2_2, opt2_con(cdr(arg))); return(c_call(arg)(sc, sc->t2_1)); @@ -49868,10 +50115,10 @@ static s7_pointer fx_c_s_opssq(s7_scheme { s7_pointer largs; largs = caddr(arg); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(largs))); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, opt2_sym(cdr(largs)))); + set_car(sc->t2_1, lookup(sc, cadr(largs))); + set_car(sc->t2_2, lookup(sc, opt2_sym(cdr(largs)))); set_car(sc->t2_2, c_call(largs)(sc, sc->t2_1)); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(arg))); + set_car(sc->t2_1, lookup(sc, cadr(arg))); return(c_call(arg)(sc, sc->t2_1)); } @@ -49880,9 +50127,9 @@ static s7_pointer fx_equal_add_ss(s7_sch { s7_pointer largs, x, y, z; largs = caddr(arg); - x = symbol_to_value_unchecked(sc, cadr(largs)); - y = symbol_to_value_unchecked(sc, caddr(largs)); - z = symbol_to_value_unchecked(sc, cadr(arg)); + x = lookup(sc, cadr(largs)); + y = lookup(sc, caddr(largs)); + z = lookup(sc, cadr(arg)); if ((is_integer(x)) && (is_integer(y)) && (is_integer(z))) return(make_boolean(sc, (integer(x) + integer(y)) == integer(z))); return(c_equal_2(sc, z, add_p_pp(sc, x, y))); @@ -49893,8 +50140,8 @@ static s7_pointer fx_c_c_opssq(s7_scheme { s7_pointer largs; largs = caddr(arg); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(largs))); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, opt2_sym(cdr(largs)))); + set_car(sc->t2_1, lookup(sc, cadr(largs))); + set_car(sc->t2_2, lookup(sc, opt2_sym(cdr(largs)))); set_car(sc->t2_2, c_call(largs)(sc, sc->t2_1)); set_car(sc->t2_1, cadr(arg)); return(c_call(arg)(sc, sc->t2_1)); @@ -49905,8 +50152,8 @@ static s7_pointer direct_x_c_c_opssq(s7_ s7_pointer largs; s7_double x2; largs = caddr(arg); - x2 = ((s7_d_pd_t)opt3_direct_x(cddr(arg)))(symbol_to_value_unchecked(sc, cadr(largs)), - real_to_double(sc, symbol_to_value_unchecked(sc, opt2_sym(cdr(largs))), "number_to_double")); + x2 = ((s7_d_pd_t)opt3_direct_x(cddr(arg)))(lookup(sc, cadr(largs)), + real_to_double(sc, lookup(sc, opt2_sym(cdr(largs))), "number_to_double")); return(((s7_p_dd_t)opt2_direct_x_call(cdr(arg)))(sc, real_to_double(sc, cadr(arg), "*"), x2)); } @@ -49914,10 +50161,10 @@ static s7_pointer fx_c_s_opscq(s7_scheme { s7_pointer largs; largs = caddr(arg); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(largs))); + set_car(sc->t2_1, lookup(sc, cadr(largs))); set_car(sc->t2_2, opt2_con(cdr(largs))); set_car(sc->t2_2, c_call(largs)(sc, sc->t2_1)); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(arg))); + set_car(sc->t2_1, lookup(sc, cadr(arg))); return(c_call(arg)(sc, sc->t2_1)); } @@ -49925,37 +50172,30 @@ static s7_pointer fx_c_s_opsq(s7_scheme { s7_pointer largs; largs = caddr(arg); - set_car(sc->t1_1, symbol_to_value_unchecked(sc, cadr(largs))); + set_car(sc->t1_1, lookup(sc, cadr(largs))); set_car(sc->t2_2, c_call(largs)(sc, sc->t1_1)); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(arg))); + set_car(sc->t2_1, lookup(sc, cadr(arg))); return(c_call(arg)(sc, sc->t2_1)); } static s7_pointer fx_c_s_car(s7_scheme *sc, s7_pointer arg) { s7_pointer val; - val = symbol_to_value_unchecked(sc, opt2_sym(cdr(arg))); + val = lookup(sc, opt2_sym(cdr(arg))); set_car(sc->t2_2, (is_pair(val)) ? car(val) : g_car(sc, set_plist_1(sc, val))); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(arg))); + set_car(sc->t2_1, lookup(sc, cadr(arg))); return(c_call(arg)(sc, sc->t2_1)); } static s7_pointer fx_add_s_car(s7_scheme *sc, s7_pointer arg) { -#if 0 - s7_pointer val; - val = symbol_to_value_unchecked(sc, opt2_sym(cdr(arg))); - val = (is_pair(val)) ? car(val) : g_car(sc, set_plist_1(sc, val)); - return(add_p_pp(sc, symbol_to_value_unchecked(sc, cadr(arg)), val)); -#else s7_pointer val1, val2; - val2 = symbol_to_value_unchecked(sc, opt2_sym(cdr(arg))); + val2 = lookup(sc, opt2_sym(cdr(arg))); val2 = (is_pair(val2)) ? car(val2) : g_car(sc, set_plist_1(sc, val2)); - val1 = symbol_to_value_unchecked(sc, cadr(arg)); + val1 = lookup(sc, cadr(arg)); if ((is_t_integer(val1)) && (is_t_integer(val2))) return(make_integer(sc, integer(val1) + integer(val2))); return(add_p_pp(sc, val1, val2)); -#endif } static s7_pointer fx_c_op_s_opsq_q(s7_scheme *sc, s7_pointer arg) @@ -49963,9 +50203,9 @@ static s7_pointer fx_c_op_s_opsq_q(s7_sc s7_pointer outer, args; outer = cadr(arg); args = caddr(outer); - set_car(sc->t1_1, symbol_to_value_unchecked(sc, cadr(args))); + set_car(sc->t1_1, lookup(sc, cadr(args))); set_car(sc->t2_2, c_call(args)(sc, sc->t1_1)); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(outer))); + set_car(sc->t2_1, lookup(sc, cadr(outer))); set_car(sc->t1_1, c_call(outer)(sc, sc->t2_1)); return(c_call(arg)(sc, sc->t1_1)); } @@ -49975,9 +50215,9 @@ static s7_pointer fx_c_op_opsq_s_q(s7_sc s7_pointer outer, args; outer = cadr(arg); args = cadr(outer); - set_car(sc->t1_1, symbol_to_value_unchecked(sc, cadr(args))); + set_car(sc->t1_1, lookup(sc, cadr(args))); set_car(sc->t2_1, c_call(args)(sc, sc->t1_1)); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, caddr(outer))); + set_car(sc->t2_2, lookup(sc, caddr(outer))); set_car(sc->t1_1, c_call(outer)(sc, sc->t2_1)); return(c_call(arg)(sc, sc->t1_1)); } @@ -49986,7 +50226,7 @@ static s7_pointer fx_c_c_opsq(s7_scheme { s7_pointer largs; largs = caddr(arg); - set_car(sc->t1_1, symbol_to_value_unchecked(sc, cadr(largs))); + set_car(sc->t1_1, lookup(sc, cadr(largs))); set_car(sc->t2_2, c_call(largs)(sc, sc->t1_1)); set_car(sc->t2_1, cadr(arg)); return(c_call(arg)(sc, sc->t2_1)); @@ -49997,8 +50237,8 @@ static s7_pointer direct_x_c_opsq_opsq(s s7_double x1, x2; s7_pointer p; p = cdr(arg); - x1 = ((s7_d_p_t)opt3_direct_x(p))(symbol_to_value_unchecked(sc, cadar(p))); - x2 = ((s7_d_p_t)opt3_direct_x(cdr(p)))(symbol_to_value_unchecked(sc, cadadr(p))); + x1 = ((s7_d_p_t)opt3_direct_x(p))(lookup(sc, cadar(p))); + x2 = ((s7_d_p_t)opt3_direct_x(cdr(p)))(lookup(sc, cadadr(p))); return(((s7_p_dd_t)opt2_direct_x_call(p))(sc, x1, x2)); } @@ -50008,10 +50248,10 @@ static s7_pointer fx_c_opsq_opsq(s7_sche int32_t tx; tx = next_tx(sc); largs = cdr(arg); - set_car(sc->t1_1, symbol_to_value_unchecked(sc, cadr(car(largs)))); + set_car(sc->t1_1, lookup(sc, cadr(car(largs)))); sc->t_temps[tx] = c_call(car(largs))(sc, sc->t1_1); largs = cadr(largs); - set_car(sc->t1_1, symbol_to_value_unchecked(sc, cadr(largs))); + set_car(sc->t1_1, lookup(sc, cadr(largs))); set_car(sc->t2_2, c_call(largs)(sc, sc->t1_1)); set_car(sc->t2_1, sc->t_temps[tx]); return(c_call(arg)(sc, sc->t2_1)); @@ -50023,9 +50263,9 @@ static s7_pointer fx_c_opdq_opsq(s7_sche int32_t tx; tx = next_tx(sc); largs = cdr(arg); - sc->t_temps[tx] = c_call(car(largs))(sc, cdar(largs)); + sc->t_temps[tx] = d_call(sc, car(largs)); largs = cadr(largs); - set_car(sc->t1_1, symbol_to_value_unchecked(sc, cadr(largs))); + set_car(sc->t1_1, lookup(sc, cadr(largs))); set_car(sc->t2_2, c_call(largs)(sc, sc->t1_1)); set_car(sc->t2_1, sc->t_temps[tx]); return(c_call(arg)(sc, sc->t2_1)); @@ -50038,10 +50278,10 @@ static s7_pointer fx_c_opdq_opssq(s7_sch s7_pointer args; tx = next_tx(sc); args = cdr(arg); - sc->t_temps[tx] = c_call(car(args))(sc, cdar(args)); + sc->t_temps[tx] = d_call(sc, car(args)); args = cdr(args); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadar(args))); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, caddar(args))); + set_car(sc->t2_1, lookup(sc, cadar(args))); + set_car(sc->t2_2, lookup(sc, caddar(args))); set_car(sc->t2_2, c_call(car(args))(sc, sc->t2_1)); set_car(sc->t2_1, sc->t_temps[tx]); sc->t_temps[tx] = sc->F; @@ -50054,10 +50294,10 @@ static s7_pointer fx_c_opsq_opdq(s7_sche int32_t tx; tx = next_tx(sc); largs = cdr(arg); - set_car(sc->t1_1, symbol_to_value_unchecked(sc, cadr(car(largs)))); + set_car(sc->t1_1, lookup(sc, cadr(car(largs)))); sc->t_temps[tx] = c_call(car(largs))(sc, sc->t1_1); largs = cadr(largs); - set_car(sc->t2_2, c_call(largs)(sc, cdr(largs))); + set_car(sc->t2_2, d_call(sc, largs)); set_car(sc->t2_1, sc->t_temps[tx]); return(c_call(arg)(sc, sc->t2_1)); } @@ -50068,11 +50308,11 @@ static s7_pointer fx_c_opsq_opssq(s7_sch int32_t tx; tx = next_tx(sc); largs = cdr(arg); - set_car(sc->t1_1, symbol_to_value_unchecked(sc, cadr(car(largs)))); + set_car(sc->t1_1, lookup(sc, cadr(car(largs)))); sc->t_temps[tx] = c_call(car(largs))(sc, sc->t1_1); largs = cadr(largs); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(largs))); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, caddr(largs))); + set_car(sc->t2_1, lookup(sc, cadr(largs))); + set_car(sc->t2_2, lookup(sc, caddr(largs))); set_car(sc->t2_2, c_call(largs)(sc, sc->t2_1)); set_car(sc->t2_1, sc->t_temps[tx]); return(c_call(arg)(sc, sc->t2_1)); @@ -50084,11 +50324,11 @@ static s7_pointer fx_c_opssq_opsq(s7_sch int32_t tx; tx = next_tx(sc); largs = cdr(arg); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(car(largs)))); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, opt2_sym(cdr(car(largs))))); + set_car(sc->t2_1, lookup(sc, cadr(car(largs)))); + set_car(sc->t2_2, lookup(sc, opt2_sym(cdr(car(largs))))); sc->t_temps[tx] = c_call(car(largs))(sc, sc->t2_1); largs = cadr(largs); - set_car(sc->t1_1, symbol_to_value_unchecked(sc, cadr(largs))); + set_car(sc->t1_1, lookup(sc, cadr(largs))); set_car(sc->t2_2, c_call(largs)(sc, sc->t1_1)); set_car(sc->t2_1, sc->t_temps[tx]); return(c_call(arg)(sc, sc->t2_1)); @@ -50100,11 +50340,11 @@ static s7_pointer fx_c_opssq_opdq(s7_sch int32_t tx; tx = next_tx(sc); largs = cdr(arg); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(car(largs)))); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, opt2_sym(cdr(car(largs))))); + set_car(sc->t2_1, lookup(sc, cadr(car(largs)))); + set_car(sc->t2_2, lookup(sc, opt2_sym(cdr(car(largs))))); sc->t_temps[tx] = c_call(car(largs))(sc, sc->t2_1); largs = cadr(largs); - set_car(sc->t2_2, c_call(largs)(sc, cdr(largs))); + set_car(sc->t2_2, d_call(sc, largs)); set_car(sc->t2_1, sc->t_temps[tx]); return(c_call(arg)(sc, sc->t2_1)); } @@ -50115,12 +50355,12 @@ static s7_pointer fx_c_opssq_opssq(s7_sc int32_t tx; tx = next_tx(sc); largs = cdr(arg); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(car(largs)))); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, opt2_sym(cdr(car(largs))))); + set_car(sc->t2_1, lookup(sc, cadr(car(largs)))); + set_car(sc->t2_2, lookup(sc, opt2_sym(cdr(car(largs))))); sc->t_temps[tx] = c_call(car(largs))(sc, sc->t2_1); largs = cadr(largs); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(largs))); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, opt2_sym(cdr(largs)))); + set_car(sc->t2_1, lookup(sc, cadr(largs))); + set_car(sc->t2_2, lookup(sc, opt2_sym(cdr(largs)))); set_car(sc->t2_2, c_call(largs)(sc, sc->t2_1)); set_car(sc->t2_1, sc->t_temps[tx]); return(c_call(arg)(sc, sc->t2_1)); @@ -50132,11 +50372,11 @@ static s7_pointer fx_c_opscq_opscq(s7_sc int32_t tx; tx = next_tx(sc); largs = cdr(arg); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(car(largs)))); + set_car(sc->t2_1, lookup(sc, cadr(car(largs)))); set_car(sc->t2_2, opt2_con(cdr(car(largs)))); sc->t_temps[tx] = c_call(car(largs))(sc, sc->t2_1); largs = cadr(largs); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(largs))); + set_car(sc->t2_1, lookup(sc, cadr(largs))); set_car(sc->t2_2, opt2_con(cdr(largs))); set_car(sc->t2_2, c_call(largs)(sc, sc->t2_1)); set_car(sc->t2_1, sc->t_temps[tx]); @@ -50147,8 +50387,8 @@ static s7_pointer fx_c_op_opssq_q_c(s7_s { s7_pointer arg; arg = cadadr(code); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(arg))); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, opt2_sym(cdr(arg)))); + set_car(sc->t2_1, lookup(sc, cadr(arg))); + set_car(sc->t2_2, lookup(sc, opt2_sym(cdr(arg)))); set_car(sc->t1_1, c_call(arg)(sc, sc->t2_1)); set_car(sc->t2_1, c_call(cadr(code))(sc, sc->t1_1)); set_car(sc->t2_2, caddr(code)); @@ -50159,7 +50399,7 @@ static s7_pointer fx_c_op_opsq_q(s7_sche { s7_pointer arg; arg = cadadr(code); - set_car(sc->t1_1, symbol_to_value_unchecked(sc, cadr(arg))); + set_car(sc->t1_1, lookup(sc, cadr(arg))); set_car(sc->t1_1, c_call(arg)(sc, sc->t1_1)); set_car(sc->t1_1, c_call(cadr(code))(sc, sc->t1_1)); return(c_call(code)(sc, sc->t1_1)); @@ -50170,12 +50410,12 @@ static s7_pointer fx_c_s_op_s_opsqq(s7_s s7_pointer args, val, val1; args = caddr(code); val1 = caddr(args); - val = symbol_to_value_unchecked(sc, cadr(args)); - set_car(sc->t1_1, symbol_to_value_unchecked(sc, cadr(val1))); + val = lookup(sc, cadr(args)); + set_car(sc->t1_1, lookup(sc, cadr(val1))); set_car(sc->t2_2, c_call(val1)(sc, sc->t1_1)); set_car(sc->t2_1, val); set_car(sc->t2_2, c_call(args)(sc, sc->t2_1)); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(code))); + set_car(sc->t2_1, lookup(sc, cadr(code))); return(c_call(code)(sc, sc->t2_1)); } @@ -50184,12 +50424,12 @@ static s7_pointer fx_c_s_op_opsq_cq(s7_s s7_pointer args, val, val1; args = caddr(code); val1 = cadr(args); - val = symbol_to_value_unchecked(sc, cadr(val1)); + val = lookup(sc, cadr(val1)); set_car(sc->t1_1, val); set_car(sc->t2_1, c_call(val1)(sc, sc->t1_1)); - set_car(sc->t2_2, caddr(args)); + set_car(sc->t2_2, opt2_con(cdr(args))); /* caddr(args) E_C_PC in combine_ops */ set_car(sc->t2_2, c_call(args)(sc, sc->t2_1)); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(code))); + set_car(sc->t2_1, lookup(sc, cadr(code))); return(c_call(code)(sc, sc->t2_1)); } @@ -50198,13 +50438,13 @@ static s7_pointer fx_c_s_op_s_opssqq(s7_ s7_pointer args, val, val1; args = caddr(code); val1 = caddr(args); - val = symbol_to_value_unchecked(sc, cadr(args)); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(val1))); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, opt2_sym(cdr(val1)))); + val = lookup(sc, cadr(args)); + set_car(sc->t2_1, lookup(sc, cadr(val1))); + set_car(sc->t2_2, lookup(sc, opt2_sym(cdr(val1)))); set_car(sc->t2_2, c_call(val1)(sc, sc->t2_1)); set_car(sc->t2_1, val); set_car(sc->t2_2, c_call(args)(sc, sc->t2_1)); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(code))); + set_car(sc->t2_1, lookup(sc, cadr(code))); return(c_call(code)(sc, sc->t2_1)); } @@ -50212,10 +50452,10 @@ static s7_pointer fx_c_op_opsq_q_s(s7_sc { s7_pointer arg; arg = cadadr(code); - set_car(sc->t1_1, symbol_to_value_unchecked(sc, cadr(arg))); + set_car(sc->t1_1, lookup(sc, cadr(arg))); set_car(sc->t1_1, c_call(arg)(sc, sc->t1_1)); set_car(sc->t2_1, c_call(cadr(code))(sc, sc->t1_1)); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, caddr(code))); + set_car(sc->t2_2, lookup(sc, caddr(code))); return(c_call(code)(sc, sc->t2_1)); } @@ -50223,7 +50463,7 @@ static s7_pointer fx_c_op_opsq_q_c(s7_sc { s7_pointer arg; arg = cadadr(code); - set_car(sc->t1_1, symbol_to_value_unchecked(sc, cadr(arg))); + set_car(sc->t1_1, lookup(sc, cadr(arg))); set_car(sc->t1_1, c_call(arg)(sc, sc->t1_1)); set_car(sc->t2_1, c_call(cadr(code))(sc, sc->t1_1)); set_car(sc->t2_2, caddr(code)); @@ -50232,50 +50472,50 @@ static s7_pointer fx_c_op_opsq_q_c(s7_sc static s7_pointer fx_c_a(s7_scheme *sc, s7_pointer arg) { - set_car(sc->t1_1, c_call(cdr(arg))(sc, cadr(arg))); + set_car(sc->t1_1, fx_call(sc, cdr(arg))); return(c_call(arg)(sc, sc->t1_1)); } static s7_pointer fx_not_a(s7_scheme *sc, s7_pointer arg) { - return((c_call(cdr(arg))(sc, cadr(arg)) == sc->F) ? sc->T : sc->F); + return((fx_call(sc, cdr(arg)) == sc->F) ? sc->T : sc->F); } static s7_pointer fx_c_ssa(s7_scheme *sc, s7_pointer arg) { - set_car(sc->t3_3, c_call(cdddr(arg))(sc, cadddr(arg))); - set_car(sc->t3_1, symbol_to_value_unchecked(sc, cadr(arg))); - set_car(sc->t3_2, symbol_to_value_unchecked(sc, caddr(arg))); + set_car(sc->t3_3, fx_call(sc, cdddr(arg))); + set_car(sc->t3_1, lookup(sc, cadr(arg))); + set_car(sc->t3_2, lookup(sc, caddr(arg))); return(c_call(arg)(sc, sc->t3_1)); } static s7_pointer fx_c_sas(s7_scheme *sc, s7_pointer arg) { - set_car(sc->t3_2, c_call(cddr(arg))(sc, caddr(arg))); - set_car(sc->t3_1, symbol_to_value_unchecked(sc, cadr(arg))); - set_car(sc->t3_3, symbol_to_value_unchecked(sc, cadddr(arg))); + set_car(sc->t3_2, fx_call(sc, cddr(arg))); + set_car(sc->t3_1, lookup(sc, cadr(arg))); + set_car(sc->t3_3, lookup(sc, cadddr(arg))); return(c_call(arg)(sc, sc->t3_1)); } static s7_pointer fx_c_sca(s7_scheme *sc, s7_pointer arg) { - set_car(sc->t3_3, c_call(cdddr(arg))(sc, cadddr(arg))); - set_car(sc->t3_1, symbol_to_value_unchecked(sc, cadr(arg))); + set_car(sc->t3_3, fx_call(sc, cdddr(arg))); + set_car(sc->t3_1, lookup(sc, cadr(arg))); set_car(sc->t3_2, caddr(arg)); return(c_call(arg)(sc, sc->t3_1)); } static s7_pointer fx_c_csa(s7_scheme *sc, s7_pointer arg) { - set_car(sc->t3_3, c_call(cdddr(arg))(sc, cadddr(arg))); + set_car(sc->t3_3, fx_call(sc, cdddr(arg))); set_car(sc->t3_1, cadr(arg)); - set_car(sc->t3_2, symbol_to_value_unchecked(sc, caddr(arg))); + set_car(sc->t3_2, lookup(sc, caddr(arg))); return(c_call(arg)(sc, sc->t3_1)); } static s7_pointer fx_c_cac(s7_scheme *sc, s7_pointer arg) { - set_car(sc->t3_2, c_call(cddr(arg))(sc, caddr(arg))); + set_car(sc->t3_2, fx_call(sc, cddr(arg))); set_car(sc->t3_1, cadr(arg)); set_car(sc->t3_3, cadddr(arg)); return(c_call(arg)(sc, sc->t3_1)); @@ -50286,8 +50526,8 @@ static s7_pointer fx_c_aa(s7_scheme *sc, /* here neither "a" can involve a nested "a" */ int32_t tx; tx = next_tx(sc); - sc->t_temps[tx] = c_call(cdr(arg))(sc, cadr(arg)); - set_car(sc->t2_2, c_call(cddr(arg))(sc, caddr(arg))); + sc->t_temps[tx] = fx_call(sc, cdr(arg)); + set_car(sc->t2_2, fx_call(sc, cddr(arg))); set_car(sc->t2_1, sc->t_temps[tx]); return(c_call(arg)(sc, sc->t2_1)); } @@ -50297,7 +50537,7 @@ static s7_pointer fx_add_aa(s7_scheme *s s7_pointer a1, a2; a1 = cdr(arg); a2 = cdr(a1); - return(add_p_pp(sc, c_call(a1)(sc, car(a1)), c_call(a2)(sc, car(a2)))); + return(add_p_pp(sc, fx_call(sc, a1), fx_call(sc, a2))); } static s7_pointer fx_subtract_aa(s7_scheme *sc, s7_pointer arg) @@ -50305,37 +50545,7 @@ static s7_pointer fx_subtract_aa(s7_sche s7_pointer a1, a2; a1 = cdr(arg); a2 = cdr(a1); - return(subtract_p_pp(sc, c_call(a1)(sc, car(a1)), c_call(a2)(sc, car(a2)))); -} - -static s7_pointer fx_c_opaaq_opaaq(s7_scheme *sc, s7_pointer arg) -{ - /* opaaq_opaaq here where none of the "a" involve nested "a" */ - int32_t tx1, tx2; - s7_pointer p1, p2, arg11, arg12, arg21, arg22; - - p1 = cadr(arg); - arg11 = cdr(p1); - arg12 = cddr(p1); - p2 = caddr(arg); - arg21 = cdr(p2); - arg22 = cddr(p2); - - tx1 = next_tx(sc); - tx2 = next_tx(sc); - - sc->t_temps[tx1] = c_call(arg11)(sc, car(arg11)); - set_car(sc->t2_2, c_call(arg12)(sc, car(arg12))); - set_car(sc->t2_1, sc->t_temps[tx1]); - sc->t_temps[tx1] = c_call(p1)(sc, sc->t2_1); - - sc->t_temps[tx2] = c_call(arg21)(sc, car(arg21)); - set_car(sc->t2_2, c_call(arg22)(sc, car(arg22))); - set_car(sc->t2_1, sc->t_temps[tx2]); - - set_car(sc->t2_2, c_call(p2)(sc, sc->t2_1)); - set_car(sc->t2_1, sc->t_temps[tx1]); - return(c_call(arg)(sc, sc->t2_1)); + return(subtract_p_pp(sc, fx_call(sc, a1), fx_call(sc, a2))); } static s7_pointer fx_c_aaa(s7_scheme *sc, s7_pointer arg) @@ -50346,11 +50556,11 @@ static s7_pointer fx_c_aaa(s7_scheme *sc tx1 = next_tx(sc); tx2 = next_tx(sc); p = cdr(arg); - sc->t_temps[tx1] = c_call(p)(sc, car(p)); + sc->t_temps[tx1] = fx_call(sc, p); p = cdr(p); - sc->t_temps[tx2] = c_call(p)(sc, car(p)); + sc->t_temps[tx2] = fx_call(sc, p); p = cdr(p); - set_car(sc->t3_3, c_call(p)(sc, car(p))); + set_car(sc->t3_3, fx_call(sc, p)); set_car(sc->t3_2, sc->t_temps[tx2]); set_car(sc->t3_1, sc->t_temps[tx1]); return(c_call(arg)(sc, sc->t3_1)); @@ -50360,9 +50570,9 @@ static s7_pointer fx_c_opaq_s(s7_scheme { s7_pointer arg2; arg2 = cdadr(arg); - set_car(sc->t1_1, c_call(arg2)(sc, car(arg2))); + set_car(sc->t1_1, fx_call(sc, arg2)); set_car(sc->t2_1, c_call(cadr(arg))(sc, sc->t1_1)); - set_car(sc->t2_2, symbol_to_value_checked(sc, caddr(arg))); + set_car(sc->t2_2, lookup_checked(sc, caddr(arg))); return(c_call(arg)(sc, sc->t2_1)); } @@ -50370,9 +50580,9 @@ static s7_pointer fx_c_s_opaq(s7_scheme { s7_pointer arg2; arg2 = cdaddr(arg); - set_car(sc->t1_1, c_call(arg2)(sc, car(arg2))); + set_car(sc->t1_1, fx_call(sc, arg2)); set_car(sc->t2_2, c_call(caddr(arg))(sc, sc->t1_1)); - set_car(sc->t2_1, symbol_to_value_checked(sc, cadr(arg))); + set_car(sc->t2_1, lookup_checked(sc, cadr(arg))); return(c_call(arg)(sc, sc->t2_1)); } @@ -50380,16 +50590,59 @@ static s7_pointer fx_c_opaq(s7_scheme *s { s7_pointer p; p = cadr(arg); - set_car(sc->t1_1, c_call(cdr(p))(sc, cadr(p))); + set_car(sc->t1_1, fx_call(sc, cdr(p))); set_car(sc->t1_1, c_call(p)(sc, sc->t1_1)); return(c_call(arg)(sc, sc->t1_1)); } +static s7_pointer fx_c_opaaq(s7_scheme *sc, s7_pointer arg) +{ + int32_t tx1; + s7_pointer p; + tx1 = next_tx(sc); + p = cadr(arg); + sc->t_temps[tx1] = fx_call(sc, cdr(p)); + set_car(sc->t2_2, fx_call(sc, cddr(p))); + set_car(sc->t2_1, sc->t_temps[tx1]); + set_car(sc->t1_1, c_call(p)(sc, sc->t2_1)); + return(c_call(arg)(sc, sc->t1_1)); +} + +static s7_pointer fx_c_opaaq_opaaq(s7_scheme *sc, s7_pointer arg) +{ + /* none of the "a" involve nested "a", this is used heavily (12G) in tbig.scm */ + int32_t tx1, tx2; + s7_pointer p1, p2, arg11, arg12, arg21, arg22; + + p1 = cadr(arg); + arg11 = cdr(p1); + arg12 = cddr(p1); + p2 = caddr(arg); + arg21 = cdr(p2); + arg22 = cddr(p2); + + tx1 = next_tx(sc); + tx2 = next_tx(sc); + + sc->t_temps[tx1] = fx_call(sc, arg11); + set_car(sc->t2_2, fx_call(sc, arg12)); + set_car(sc->t2_1, sc->t_temps[tx1]); + sc->t_temps[tx1] = c_call(p1)(sc, sc->t2_1); + + sc->t_temps[tx2] = fx_call(sc, arg21); + set_car(sc->t2_2, fx_call(sc, arg22)); + set_car(sc->t2_1, sc->t_temps[tx2]); + + set_car(sc->t2_2, c_call(p2)(sc, sc->t2_1)); + set_car(sc->t2_1, sc->t_temps[tx1]); + return(c_call(arg)(sc, sc->t2_1)); +} + static s7_pointer fx_c_c_opscq(s7_scheme *sc, s7_pointer arg) { s7_pointer largs; largs = caddr(arg); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(largs))); + set_car(sc->t2_1, lookup(sc, cadr(largs))); set_car(sc->t2_2, opt2_con(cdr(largs))); set_car(sc->t2_2, c_call(largs)(sc, sc->t2_1)); set_car(sc->t2_1, cadr(arg)); @@ -50400,7 +50653,7 @@ static s7_pointer fx_c_c_opcsq(s7_scheme { s7_pointer largs; largs = caddr(arg); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, caddr(largs))); + set_car(sc->t2_2, lookup(sc, caddr(largs))); set_car(sc->t2_1, opt1_con(cdr(largs))); /* cadr(largs) or cadadr */ set_car(sc->t2_2, c_call(largs)(sc, sc->t2_1)); set_car(sc->t2_1, cadr(arg)); @@ -50411,10 +50664,10 @@ static s7_pointer fx_c_s_opcsq(s7_scheme { s7_pointer largs; largs = caddr(arg); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, caddr(largs))); + set_car(sc->t2_2, lookup(sc, caddr(largs))); set_car(sc->t2_1, opt1_con(cdr(largs))); /* cadr(largs) or cadadr */ set_car(sc->t2_2, c_call(largs)(sc, sc->t2_1)); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(arg))); + set_car(sc->t2_1, lookup(sc, cadr(arg))); return(c_call(arg)(sc, sc->t2_1)); } @@ -50422,11 +50675,11 @@ static s7_pointer fx_c_op_opssq_q_s(s7_s { s7_pointer arg; arg = opt3_pair(code); /* cadadr(code); */ - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(arg))); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, opt2_sym(cdr(arg)))); + set_car(sc->t2_1, lookup(sc, cadr(arg))); + set_car(sc->t2_2, lookup(sc, opt2_sym(cdr(arg)))); set_car(sc->t1_1, c_call(arg)(sc, sc->t2_1)); set_car(sc->t2_1, c_call(cadr(code))(sc, sc->t1_1)); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, caddr(code))); + set_car(sc->t2_2, lookup(sc, caddr(code))); return(c_call(code)(sc, sc->t2_1)); } @@ -50434,12 +50687,12 @@ static s7_pointer fx_c_op_opssq_sq_s(s7_ { s7_pointer arg; arg = opt3_pair(code); /* cadadr(code); */ - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(arg))); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, opt2_sym(cdr(arg)))); + set_car(sc->t2_1, lookup(sc, cadr(arg))); + set_car(sc->t2_2, lookup(sc, opt2_sym(cdr(arg)))); set_car(sc->t2_1, c_call(arg)(sc, sc->t2_1)); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, caddr(cadr(code)))); + set_car(sc->t2_2, lookup(sc, caddr(cadr(code)))); set_car(sc->t2_1, c_call(cadr(code))(sc, sc->t2_1)); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, caddr(code))); + set_car(sc->t2_2, lookup(sc, caddr(code))); return(c_call(code)(sc, sc->t2_1)); } @@ -50451,15 +50704,15 @@ static s7_pointer fx_c_s_op_opssq_opssqq args = caddr(code); op1 = cadr(args); op2 = caddr(args); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(op1))); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, opt2_sym(cdr(op1)))); + set_car(sc->t2_1, lookup(sc, cadr(op1))); + set_car(sc->t2_2, lookup(sc, opt2_sym(cdr(op1)))); sc->t_temps[tx] = c_call(op1)(sc, sc->t2_1); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(op2))); - set_car(sc->t2_2, symbol_to_value_unchecked(sc, opt2_sym(cdr(op2)))); + set_car(sc->t2_1, lookup(sc, cadr(op2))); + set_car(sc->t2_2, lookup(sc, opt2_sym(cdr(op2)))); set_car(sc->t2_2, c_call(op2)(sc, sc->t2_1)); set_car(sc->t2_1, sc->t_temps[tx]); set_car(sc->t2_2, c_call(args)(sc, sc->t2_1)); - set_car(sc->t2_1, symbol_to_value_unchecked(sc, cadr(code))); + set_car(sc->t2_1, lookup(sc, cadr(code))); sc->t_temps[tx] = sc->F; return(c_call(code)(sc, sc->t2_1)); } @@ -50471,87 +50724,163 @@ static s7_pointer fx_c_all_s(s7_scheme * tx = next_tx(sc); sc->t_temps[tx] = safe_list_if_possible(sc, integer(opt3_arglen(arg))); for (args = cdr(arg), p = sc->t_temps[tx]; is_pair(args); args = cdr(args), p = cdr(p)) - set_car(p, symbol_to_value_unchecked(sc, car(args))); + set_car(p, lookup(sc, car(args))); + clear_list_in_use(sc->t_temps[tx]); + sc->current_safe_list = 0; + return(c_call(arg)(sc, sc->t_temps[tx])); +} + +static s7_pointer fx_c_fx(s7_scheme *sc, s7_pointer arg) +{ + s7_pointer args, p; + int32_t tx; + tx = next_tx(sc); + sc->t_temps[tx] = safe_list_if_possible(sc, integer(opt3_arglen(arg))); + for (args = cdr(arg), p = sc->t_temps[tx]; is_pair(args); args = cdr(args), p = cdr(p)) + set_car(p, fx_call(sc, args)); clear_list_in_use(sc->t_temps[tx]); sc->current_safe_list = 0; return(c_call(arg)(sc, sc->t_temps[tx])); } -static s7_pointer fx_if_x2(s7_scheme *sc, s7_pointer arg) +static s7_pointer fx_if_a_aa(s7_scheme *sc, s7_pointer arg) { s7_pointer p; p = cdr(arg); - if (is_true(sc, c_call(p)(sc, car(p)))) + if (is_true(sc, fx_call(sc, p))) p = cdr(p); else p = cddr(p); - return(c_call(p)(sc, car(p))); + return(fx_call(sc, p)); } -static s7_pointer fx_and2(s7_scheme *sc, s7_pointer arg) +static s7_pointer fx_and_2(s7_scheme *sc, s7_pointer arg) { /* arg is the full expr: (and ...) */ s7_pointer p, val; p = cdr(arg); - val = c_call(p)(sc, car(p)); + val = fx_call(sc, p); if (val == sc->F) return(val); p = cdr(p); - return(c_call(p)(sc, car(p))); + return(fx_call(sc, p)); } -static s7_pointer fx_and3(s7_scheme *sc, s7_pointer arg) +static s7_pointer fx_and_3(s7_scheme *sc, s7_pointer arg) { s7_pointer p, val; p = cdr(arg); - val = c_call(p)(sc, car(p)); + val = fx_call(sc, p); if (val == sc->F) return(val); p = cdr(p); - val = c_call(p)(sc, car(p)); + val = fx_call(sc, p); if (val == sc->F) return(val); p = cdr(p); - return(c_call(p)(sc, car(p))); + return(fx_call(sc, p)); +} + +static s7_pointer fx_and_n(s7_scheme *sc, s7_pointer arg) +{ + s7_pointer p, x; + x = sc->T; + for (p = cdr(arg); is_pair(p); p = cdr(p)) + { + x = fx_call(sc, p); + if (is_false(sc, x)) + return(x); + } + return(x); +} + +static s7_pointer fx_or_2(s7_scheme *sc, s7_pointer arg) +{ + s7_pointer p, val; + p = cdr(arg); + val = fx_call(sc, p); + if (val != sc->F) return(val); + p = cdr(p); + return(fx_call(sc, p)); } -static s7_pointer fx_or2(s7_scheme *sc, s7_pointer arg) +static s7_pointer fx_or_3(s7_scheme *sc, s7_pointer arg) { s7_pointer p, val; p = cdr(arg); - val = c_call(p)(sc, car(p)); + val = fx_call(sc, p); if (val != sc->F) return(val); p = cdr(p); - return(c_call(p)(sc, car(p))); + val = fx_call(sc, p); + if (val != sc->F) return(val); + p = cdr(p); + return(fx_call(sc, p)); +} + +static s7_pointer fx_or_n(s7_scheme *sc, s7_pointer arg) +{ + s7_pointer p; + for (p = cdr(arg); is_pair(p); p = cdr(p)) + { + s7_pointer x; + x = fx_call(sc, p); + if (is_true(sc, x)) + return(x); + } + return(sc->F); +} + +static s7_pointer fx_thunk_a(s7_scheme *sc, s7_pointer code) +{ + s7_pointer f, result, old_e; + old_e = sc->envir; + f = opt1_lambda(code); + sc->envir = closure_let(f); + code = closure_body(f); + result = fx_call(sc, code); + sc->envir = old_e; + return(result); } static s7_pointer fx_closure_s_a(s7_scheme *sc, s7_pointer code) { s7_pointer result, old_e; old_e = sc->envir; - sc->envir = old_frame_with_slot(sc, closure_let(opt1_lambda(code)), symbol_to_value_unchecked(sc, opt2_sym(code))); + sc->envir = old_frame_with_slot(sc, closure_let(opt1_lambda(code)), lookup(sc, opt2_sym(code))); code = closure_body(opt1_lambda(code)); - result = c_call(code)(sc, car(code)); + result = fx_call(sc, code); sc->envir = old_e; return(result); } -static s7_pointer fx_closure_s_c(s7_scheme *sc, s7_pointer code) +static s7_pointer fx_closure_s_d(s7_scheme *sc, s7_pointer code) { s7_pointer result, old_e; old_e = sc->envir; - sc->envir = old_frame_with_slot(sc, closure_let(opt1_lambda(code)), symbol_to_value_unchecked(sc, opt2_sym(code))); + sc->envir = old_frame_with_slot(sc, closure_let(opt1_lambda(code)), lookup(sc, opt2_sym(code))); code = closure_body(opt1_lambda(code)); - result = c_call(car(code))(sc, cdar(code)); + result = d_call(sc, car(code)); sc->envir = old_e; return(result); } +static s7_pointer fx_c_closure_s_d(s7_scheme *sc, s7_pointer arg) +{ + s7_pointer old_e, clo_arg; + clo_arg = cadr(arg); + old_e = sc->envir; + sc->envir = old_frame_with_slot(sc, closure_let(opt1_lambda(clo_arg)), lookup(sc, opt2_sym(clo_arg))); + clo_arg = closure_body(opt1_lambda(clo_arg)); + set_car(sc->t1_1, d_call(sc, car(clo_arg))); + sc->envir = old_e; + return(c_call(arg)(sc, sc->t1_1)); +} + static s7_pointer fx_and_2_closure_s(s7_scheme *sc, s7_pointer code) /* safe_closure_s_a where "a" is g_and_2 */ { s7_pointer result, old_e; old_e = sc->envir; - sc->envir = old_frame_with_slot(sc, closure_let(opt1_lambda(code)), symbol_to_value_unchecked(sc, opt2_sym(code))); + sc->envir = old_frame_with_slot(sc, closure_let(opt1_lambda(code)), lookup(sc, opt2_sym(code))); code = cdar(closure_body(opt1_lambda(code))); - result = c_call(code)(sc, car(code)); + result = fx_call(sc, code); if (result != sc->F) - result = c_call(cdr(code))(sc, cadr(code)); + result = fx_call(sc, cdr(code)); sc->envir = old_e; return(result); } @@ -50560,10 +50889,10 @@ static s7_pointer fx_and_pair_closure_s( { s7_pointer result, old_e; old_e = sc->envir; - sc->envir = old_frame_with_slot(sc, closure_let(opt1_lambda(code)), symbol_to_value_unchecked(sc, opt2_sym(code))); + sc->envir = old_frame_with_slot(sc, closure_let(opt1_lambda(code)), lookup(sc, opt2_sym(code))); code = cdar(closure_body(opt1_lambda(code))); if (is_pair(slot_value(let_slots(sc->envir)))) /* pair? arg = func par, pair? is global, symbol_id=0 */ - result = c_call(cdr(code))(sc, cadr(code)); + result = fx_call(sc, cdr(code)); else result = sc->F; sc->envir = old_e; return(result); @@ -50573,9 +50902,9 @@ static s7_pointer fx_closure_a_a(s7_sche { s7_pointer result, old_e; old_e = sc->envir; - sc->envir = old_frame_with_slot(sc, closure_let(opt1_lambda(code)), c_call(cdr(code))(sc, cadr(code))); + sc->envir = old_frame_with_slot(sc, closure_let(opt1_lambda(code)), fx_call(sc, cdr(code))); code = closure_body(opt1_lambda(code)); - result = c_call(code)(sc, car(code)); + result = fx_call(sc, code); sc->envir = old_e; return(result); } @@ -50585,10 +50914,10 @@ static s7_pointer fx_closure_ss_a(s7_sch s7_pointer result, old_e; old_e = sc->envir; sc->envir = old_frame_with_two_slots(sc, closure_let(opt1_lambda(code)), - symbol_to_value_unchecked(sc, cadr(code)), - symbol_to_value_unchecked(sc, opt2_sym(code))); + lookup(sc, cadr(code)), + lookup(sc, opt2_sym(code))); code = closure_body(opt1_lambda(code)); - result = c_call(code)(sc, car(code)); + result = fx_call(sc, code); sc->envir = old_e; return(result); } @@ -50599,9 +50928,9 @@ static void fx_function_init(void) for (i = 0; i < OPT_MAX_DEFINED; i++) fx_function[i] = NULL; - fx_function[HOP_SAFE_C_D] = fx_c_c; - fx_function[HOP_SAFE_C_OR2] = fx_or2; - fx_function[HOP_SAFE_C_AND2] = fx_and2; + fx_function[HOP_SAFE_C_D] = fx_c_d; + fx_function[HOP_SAFE_C_OR2] = fx_or_2; + fx_function[HOP_SAFE_C_AND2] = fx_and_2; fx_function[HOP_SAFE_C_A] = fx_c_a; fx_function[HOP_SAFE_C_S] = fx_c_s; fx_function[HOP_SAFE_CAR_S] = fx_car_s; @@ -50682,9 +51011,11 @@ static void fx_function_init(void) fx_function[HOP_SAFE_C_opAq] = fx_c_opaq; fx_function[HOP_SAFE_C_opAq_S] = fx_c_opaq_s; fx_function[HOP_SAFE_C_S_opAq] = fx_c_s_opaq; + fx_function[HOP_SAFE_THUNK_A] = fx_thunk_a; fx_function[HOP_SAFE_CLOSURE_S_A] = fx_closure_s_a; fx_function[HOP_SAFE_CLOSURE_A_A] = fx_closure_a_a; fx_function[HOP_SAFE_CLOSURE_SS_A] = fx_closure_ss_a; + /* safe_closure_c|aa_a do not happen often */ } static s7_pointer g_not_c_c(s7_scheme *sc, s7_pointer args); @@ -50696,10 +51027,13 @@ static s7_pointer g_is_null_cadr_s(s7_sc static s7_pointer g_is_symbol_cadr_s(s7_scheme *sc, s7_pointer args); static s7_pointer g_is_eq_car(s7_scheme *sc, s7_pointer args); static s7_pointer g_is_eq_car_q(s7_scheme *sc, s7_pointer args); -static s7_pointer g_if_x2(s7_scheme *sc, s7_pointer args); +static s7_pointer g_if_a_aa(s7_scheme *sc, s7_pointer args); static s7_pointer g_and_2(s7_scheme *sc, s7_pointer args); static s7_pointer g_and_3(s7_scheme *sc, s7_pointer args); +static s7_pointer g_and_n(s7_scheme *sc, s7_pointer args); static s7_pointer g_or_2(s7_scheme *sc, s7_pointer args); +static s7_pointer g_or_3(s7_scheme *sc, s7_pointer args); +static s7_pointer g_or_n(s7_scheme *sc, s7_pointer args); static inline s7_pointer check_quote(s7_scheme *sc, s7_pointer code); static s7_p_p_t s7_p_p_function(s7_pointer f); @@ -50718,17 +51052,17 @@ static s7_function fx_choose(s7_scheme * case HOP_SAFE_C_D: if (is_global(sc->is_pair_symbol)) { - if (c_call(arg) == g_not_is_pair_s) + if (c_callee(arg) == g_not_is_pair_s) { set_opt3_sym(arg, cadadr(arg)); return(fx_not_is_pair_s); } - if (c_call(arg) == g_is_pair_cdr_s) + if (c_callee(arg) == g_is_pair_cdr_s) { set_opt2_sym(cdr(arg), cadadr(arg)); return(fx_is_pair_cdr_s); } - if (c_call(arg) == g_is_pair_cddr_s) + if (c_callee(arg) == g_is_pair_cddr_s) { set_opt2_sym(cdr(arg), cadadr(arg)); return(fx_is_pair_cddr_s); @@ -50736,12 +51070,12 @@ static s7_function fx_choose(s7_scheme * } if (is_global(sc->is_null_symbol)) { - if (c_call(arg) == g_is_null_cadr_s) + if (c_callee(arg) == g_is_null_cadr_s) { set_opt2_sym(cdr(arg), cadadr(arg)); return(fx_is_null_cadr_s); } - if (c_call(arg) == g_is_null_cddr_s) + if (c_callee(arg) == g_is_null_cddr_s) { set_opt2_sym(cdr(arg), cadadr(arg)); return(fx_is_null_cddr_s); @@ -50749,49 +51083,52 @@ static s7_function fx_choose(s7_scheme * } if (is_global(sc->is_symbol_symbol)) { - if (c_call(arg) == g_is_symbol_cadr_s) + if (c_callee(arg) == g_is_symbol_cadr_s) { set_opt2_sym(cdr(arg), cadadr(arg)); return(fx_is_symbol_cadr_s); } } - if (c_call(arg) == g_add_cs1) return(fx_c_add_s1); - if (c_call(arg) == g_subtract_cs1) return(fx_c_sub_s1); - if (c_call(arg) == g_if_x2) return(fx_if_x2); /* g_if_x1 doesn't happen much */ - if (c_call(arg) == g_and_2) return(fx_and2); - if (c_call(arg) == g_or_2) return(fx_or2); - if (c_call(arg) == g_and_3) return(fx_and3); - if ((c_call(arg) == g_add_si) && + if (c_callee(arg) == g_add_cs1) return(fx_c_add_s1); + if (c_callee(arg) == g_subtract_cs1) return(fx_c_sub_s1); + if (c_callee(arg) == g_if_a_aa) return(fx_if_a_aa); + if (c_callee(arg) == g_and_2) return(fx_and_2); + if (c_callee(arg) == g_and_3) return(fx_and_3); + if (c_callee(arg) == g_and_n) return(fx_and_n); + if (c_callee(arg) == g_or_2) return(fx_or_2); + if (c_callee(arg) == g_or_3) return(fx_or_3); + if (c_callee(arg) == g_or_n) return(fx_or_n); + if ((c_callee(arg) == g_add_si) && (checker(sc, cadr(arg), e))) return(fx_c_add_si); - if ((c_call(arg) == g_subtract_csn) && + if ((c_callee(arg) == g_subtract_csn) && (checker(sc, cadr(arg), e))) return(fx_c_sub_si); - if ((c_call(arg) == g_char_equal_s_ic) && + if ((c_callee(arg) == g_char_equal_s_ic) && (checker(sc, cadr(arg), e))) return(fx_c_char_eq); #if (!WITH_GMP) - if ((c_call(arg) == g_equal_s_ic) && + if ((c_callee(arg) == g_equal_s_ic) && (checker(sc, cadr(arg), e))) return(fx_c_equal_s_ic); #endif - if (c_call(arg) == g_is_eq_car_q) return(fx_is_eq_car_q); - if (c_call(arg) == g_not_c_c) + if (c_callee(arg) == g_is_eq_car_q) return(fx_is_eq_car_q); + if (c_callee(arg) == g_not_c_c) { - if (c_call(cadr(arg)) == g_is_eq_car_q) + if (c_callee(cadr(arg)) == g_is_eq_car_q) { set_opt2_pair(cdr(arg), cdadr(arg)); return(fx_not_is_eq_car_q); } - return(fx_not_c_c); + return(fx_not_c_d); } - if (c_call(arg) == g_hash_table_ref_ss) + if (c_callee(arg) == g_hash_table_ref_ss) return(fx_c_hash_table_ref_ss); - if (c_call(arg) == g_hash_table_ref_car) + if (c_callee(arg) == g_hash_table_ref_car) return(fx_c_hash_table_ref_car); - if (c_call(arg) == g_lint_let_ref) + if (c_callee(arg) == g_lint_let_ref) return(fx_c_lint_let_ref); - return(fx_c_c); + return(fx_c_d); case HOP_SAFE_C_S: if (car(arg) == sc->cdr_symbol) return(fx_cdr_s); @@ -50826,24 +51163,24 @@ static s7_function fx_choose(s7_scheme * { set_direct_x_opt(arg); set_opt2_direct_x_call(cdr(arg), (s7_pointer)f); - return(direct_c_s); + return(fx_o_p_p_s); } } return(fx_c_s); case HOP_SAFE_C_SS: - if (c_call(arg) == g_cons) return(fx_cons_ss); + if (c_callee(arg) == g_cons) return(fx_cons_ss); #if (!WITH_GMP) if (car(arg) == sc->eq_symbol) return(fx_equal_ss); - if (c_call(arg) == g_geq_2) return(fx_geq_ss); - if (c_call(arg) == g_greater_2) return(fx_gt_ss); - if (c_call(arg) == g_leq_2) return(fx_leq_ss); - if (c_call(arg) == g_less_2) return(fx_lt_ss); - if (c_call(arg) == g_multiply_2) return(fx_multiply_ss); -#endif - if (c_call(arg) == g_is_eq) return(fx_is_eq_ss); - if (c_call(arg) == g_add_2) return(fx_add_ss); - if (c_call(arg) == g_subtract_2) return(fx_subtract_ss); + if (c_callee(arg) == g_geq_2) return(fx_geq_ss); + if (c_callee(arg) == g_greater_2) return(fx_gt_ss); + if (c_callee(arg) == g_leq_2) return(fx_leq_ss); + if (c_callee(arg) == g_less_2) return(fx_lt_ss); + if (c_callee(arg) == g_multiply_2) return(fx_multiply_ss); +#endif + if (c_callee(arg) == g_is_eq) return(fx_is_eq_ss); + if (c_callee(arg) == g_add_2) return(fx_add_ss); + if (c_callee(arg) == g_subtract_2) return(fx_subtract_ss); return(fx_c_ss); case HOP_SAFE_C_S_opSSq: @@ -50884,7 +51221,7 @@ static s7_function fx_choose(s7_scheme * return(fx_c_opsq); case HOP_SAFE_C_SC: - if ((c_call(arg) == g_memq_2) && (is_pair(caddr(arg)))) return(fx_memq_sq_2); + if ((c_callee(arg) == g_memq_2) && (is_pair(caddr(arg)))) return(fx_memq_sq_2); return(fx_c_sc); case HOP_SAFE_C_S_opSq: @@ -50910,13 +51247,14 @@ static s7_function fx_choose(s7_scheme * case HOP_SAFE_C_A: if (car(arg) == sc->not_symbol) return(fx_not_a); + if (c_callee(cdr(arg)) == fx_closure_s_d) return(fx_c_closure_s_d); return(fx_c_a); case HOP_SAFE_C_AA: if (aa_is_fx_safe(arg)) { - if (c_call(arg) == g_add_2) return(fx_add_aa); - if (c_call(arg) == g_subtract_2) return(fx_subtract_aa); + if (c_callee(arg) == g_add_2) return(fx_add_aa); + if (c_callee(arg) == g_subtract_2) return(fx_subtract_aa); return(fx_c_aa); } if (opaaq_opaaq_is_fx_safe(arg)) return(fx_c_opaaq_opaaq); @@ -50926,6 +51264,14 @@ static s7_function fx_choose(s7_scheme * if (aaa_is_fx_safe(arg)) return(fx_c_aaa); return(NULL); + case HOP_SAFE_C_opAAq: + if (aa_is_fx_safe(cadr(arg))) return(fx_c_opaaq); + return(NULL); + + case HOP_SAFE_C_FX: + if (is_fx_safe(sc, arg)) return(fx_c_fx); + return(NULL); + case HOP_SAFE_CLOSURE_S_A: { s7_pointer body; @@ -50933,7 +51279,7 @@ static s7_function fx_choose(s7_scheme * if ((is_pair(body)) && (is_h_safe_c_d(body))) { - if (c_call(body) == g_and_2) + if (c_callee(body) == g_and_2) { if ((caadr(body) == sc->is_pair_symbol) && (symbol_id(sc->is_pair_symbol) == 0) && @@ -50941,9 +51287,11 @@ static s7_function fx_choose(s7_scheme * return(fx_and_pair_closure_s); return(fx_and_2_closure_s); } - return(fx_closure_s_c); + return(fx_closure_s_d); } } + /* let_a_a never happens in an fx context */ + default: /* if ((!fx_function[optimize_op(arg)]) && (is_h_optimized(arg))) fprintf(stderr, "fx_choose %s %s\n", DISPLAY(arg), op_names[optimize_op(arg)]); */ return(fx_function[optimize_op(arg)]); @@ -50972,20 +51320,22 @@ static s7_function fx_choose(s7_scheme * /* -------------------------------------------------------------------------------- */ -enum {o_d_v, o_d_vd, o_d_vdd, o_d_vid, o_d_id, o_d_7pi, o_d_ip, o_d_pd, o_d_7pid, o_d, o_d_d, o_d_dd, o_d_7dd, o_d_ddd, o_d_dddd, - o_i_i, o_i_7i, o_i_ii, o_i_7ii, o_i_iii, o_i_7pi, o_i_7pii, o_d_p, +enum {o_d_v, o_d_vd, o_d_vdd, o_d_vid, o_d_id, o_d_7pi, o_d_7pii, o_d_7piid, + o_d_ip, o_d_pd, o_d_7pid, o_d, o_d_d, o_d_dd, o_d_7dd, o_d_ddd, o_d_dddd, + o_i_i, o_i_7i, o_i_ii, o_i_7ii, o_i_iii, o_i_7pi, o_i_7pii, o_i_7piii, o_d_p, o_b_p, o_b_p_direct, o_b_7p, o_b_pp, o_b_7pp, o_b_pp_direct, o_b_pi, o_b_ii, o_b_dd, - o_p, o_p_p, o_p_ii, o_p_dd, o_i_7d, o_i_7p, o_d_7d, o_d_7p, - o_p_pp, o_p_pp_direct, o_p_ppp, o_p_ppp_direct, o_p_pi, o_p_pi_direct, o_p_ppi, o_p_pip, o_p_pip_direct, o_b_i, o_b_d}; + o_p, o_p_p, o_p_ii, o_p_d, o_p_dd, o_i_7d, o_i_7p, o_d_7d, o_d_7p, + o_p_pp, o_p_pp_direct, o_p_ppp, o_p_ppp_direct, o_p_pi, o_p_pi_direct, + o_p_ppi, o_p_i, o_p_pii, o_p_pip, o_p_pip_direct, o_p_piip, o_b_i, o_b_d}; #if S7_DEBUGGING -static const char *o_names[] = {"o_d_v", "o_d_vd", "o_d_vdd", "o_d_vid", "o_d_id", "o_d_7pi", "o_d_ip", "o_d_pd", "o_d_7pid", - "o_d", "o_d_d", "o_d_dd", "o_d_7dd", "o_d_ddd", "o_d_dddd", - "o_i_i", "o_i_7i", "o_i_ii", "o_i_7ii", "o_i_iii", "o_i_7pi", "o_i_7pii", "o_d_p", +static const char *o_names[] = {"o_d_v", "o_d_vd", "o_d_vdd", "o_d_vid", "o_d_id", "o_d_7pi", "o_d_7pii", "o_d_7piid", + "o_d_ip", "o_d_pd", "o_d_7pid", "o_d", "o_d_d", "o_d_dd", "o_d_7dd", "o_d_ddd", "o_d_dddd", + "o_i_i", "o_i_7i", "o_i_ii", "o_i_7ii", "o_i_iii", "o_i_7pi", "o_i_7pii", "o_i_7_piii", "o_d_p", "o_b_p", "o_b_p_direct", "o_b_7p", "o_b_pp", "o_b_7pp", "o_b_pp_direct", "o_b_pi", "o_b_ii", "o_b_dd", - "o_p", "o_p_p", "o_p_ii", "o_p_dd", "o_i_7d", "o_i_7p", "o_d_7d", "o_d_7p", + "o_p", "o_p_p", "o_p_ii", "o_p_d", "o_p_dd", "o_i_7d", "o_i_7p", "o_d_7d", "o_d_7p", "o_p_pp", "o_p_pp_direct", "o_p_ppp", "o_p_ppp_direct", "o_p_pi", "o_p_pi_direct", - "o_p_ppi", "o_p_pip", "o_p_pip_direct", "o_b_i", "o_b_d"}; + "o_p_ppi", "o_p_i", "o_p_pii", "o_p_pip", "o_p_pip_direct", "o_p_piip", "o_b_i", "o_b_d"}; #endif static void add_opt_func(s7_pointer f, int32_t typ, void *func) @@ -51014,6 +51364,13 @@ static void add_opt_func(s7_pointer f, i op->next = c_function_opt_data(f); c_function_opt_data(f) = op; } +#if S7_DEBUGGING + else + { + fprintf(stderr, "%s[%d]: 'f' is not a c_function\n", __func__, __LINE__); + if (stop_at_error) abort(); + } +#endif } static void *opt_func(s7_pointer f, int32_t typ) @@ -51025,6 +51382,9 @@ static void *opt_func(s7_pointer f, int3 if (p->typ == typ) return(p->func); } +#if S7_DEBUGGING + else fprintf(stderr, "%s[%d]: 'f' is not a c_function\n", __func__, __LINE__); +#endif return(NULL); } @@ -51071,6 +51431,9 @@ s7_b_p_t s7_b_p_function(s7_pointer f) { void s7_set_d_7pi_function(s7_pointer f, s7_d_7pi_t df) {add_opt_func(f, o_d_7pi, (void *)df);} s7_d_7pi_t s7_d_7pi_function(s7_pointer f) {return((s7_d_7pi_t)opt_func(f, o_d_7pi));} +static void s7_set_d_7pii_function(s7_pointer f, s7_d_7pii_t df) {add_opt_func(f, o_d_7pii, (void *)df);} +static s7_d_7pii_t s7_d_7pii_function(s7_pointer f) {return((s7_d_7pii_t)opt_func(f, o_d_7pii));} + void s7_set_i_7p_function(s7_pointer f, s7_i_7p_t df) {add_opt_func(f, o_i_7p, (void *)df);} s7_i_7p_t s7_i_7p_function(s7_pointer f) {return((s7_i_7p_t)opt_func(f, o_i_7p));} @@ -51094,9 +51457,7 @@ s7_i_7d_t s7_i_7d_function(s7_pointer f) static void s7_set_d_7dd_function(s7_pointer f, s7_d_7dd_t df) {add_opt_func(f, o_d_7dd, (void *)df);} static s7_d_7dd_t s7_d_7dd_function(s7_pointer f) {return((s7_d_7dd_t)opt_func(f, o_d_7dd));} -#if (!WITH_GMP) static void s7_set_i_7i_function(s7_pointer f, s7_i_7i_t df) {add_opt_func(f, o_i_7i, (void *)df);} -#endif static s7_i_7i_t s7_i_7i_function(s7_pointer f) {return((s7_i_7i_t)opt_func(f, o_i_7i));} static void s7_set_i_7ii_function(s7_pointer f, s7_i_7ii_t df) {add_opt_func(f, o_i_7ii, (void *)df);} @@ -51117,6 +51478,9 @@ static s7_i_7pi_t s7_i_7pi_function(s7_p static void s7_set_i_7pii_function(s7_pointer f, s7_i_7pii_t df) {add_opt_func(f, o_i_7pii, (void *)df);} static s7_i_7pii_t s7_i_7pii_function(s7_pointer f) {return((s7_i_7pii_t)opt_func(f, o_i_7pii));} +static void s7_set_i_7piii_function(s7_pointer f, s7_i_7piii_t df) {add_opt_func(f, o_i_7piii, (void *)df);} +static s7_i_7piii_t s7_i_7piii_function(s7_pointer f) {return((s7_i_7piii_t)opt_func(f, o_i_7piii));} + static void s7_set_b_d_function(s7_pointer f, s7_b_d_t df) {add_opt_func(f, o_b_d, (void *)df);} static s7_b_d_t s7_b_d_function(s7_pointer f) {return((s7_b_d_t)opt_func(f, o_b_d));} @@ -51138,14 +51502,10 @@ static s7_b_7pp_t s7_b_7pp_function(s7_p static void s7_set_d_7d_function(s7_pointer f, s7_d_7d_t df) {add_opt_func(f, o_d_7d, (void *)df);} static s7_d_7d_t s7_d_7d_function(s7_pointer f) {return((s7_d_7d_t)opt_func(f, o_d_7d));} -#if (!WITH_GMP) static void s7_set_d_7p_function(s7_pointer f, s7_d_7p_t df) {add_opt_func(f, o_d_7p, (void *)df);} -#endif static s7_d_7p_t s7_d_7p_function(s7_pointer f) {return((s7_d_7p_t)opt_func(f, o_d_7p));} -#if (!WITH_GMP) static void s7_set_b_pi_function(s7_pointer f, s7_b_pi_t df) {add_opt_func(f, o_b_pi, (void *)df);} -#endif static s7_b_pi_t s7_b_pi_function(s7_pointer f) {return((s7_b_pi_t)opt_func(f, o_b_pi));} static void s7_set_b_ii_function(s7_pointer f, s7_b_ii_t df) {add_opt_func(f, o_b_ii, (void *)df);} @@ -51169,6 +51529,12 @@ static s7_p_ppp_t s7_p_ppp_function(s7_p static void s7_set_p_pip_function(s7_pointer f, s7_p_pip_t df) {add_opt_func(f, o_p_pip, (void *)df);} static s7_p_pip_t s7_p_pip_function(s7_pointer f) {return((s7_p_pip_t)opt_func(f, o_p_pip));} +static void s7_set_p_pii_function(s7_pointer f, s7_p_pii_t df) {add_opt_func(f, o_p_pii, (void *)df);} +static s7_p_pii_t s7_p_pii_function(s7_pointer f) {return((s7_p_pii_t)opt_func(f, o_p_pii));} + +static void s7_set_p_piip_function(s7_pointer f, s7_p_piip_t df) {add_opt_func(f, o_p_piip, (void *)df);} +static s7_p_piip_t s7_p_piip_function(s7_pointer f) {return((s7_p_piip_t)opt_func(f, o_p_piip));} + static void s7_set_p_pi_direct_function(s7_pointer f, s7_p_pi_t df) {add_opt_func(f, o_p_pi_direct, (void *)df);} static s7_p_pi_t s7_p_pi_direct_function(s7_pointer f) {return((s7_p_pi_t)opt_func(f, o_p_pi_direct));} @@ -51184,12 +51550,19 @@ static s7_p_ppp_t s7_p_ppp_direct_functi static void s7_set_b_pp_direct_function(s7_pointer f, s7_b_pp_t df) {add_opt_func(f, o_b_pp_direct, (void *)df);} static s7_b_pp_t s7_b_pp_direct_function(s7_pointer f) {return((s7_b_pp_t)opt_func(f, o_b_pp_direct));} +static void s7_set_p_i_function(s7_pointer f, s7_p_i_t df) {add_opt_func(f, o_p_i, (void *)df);} +static s7_p_i_t s7_p_i_function(s7_pointer f) {return((s7_p_i_t)opt_func(f, o_p_i));} + static void s7_set_p_ii_function(s7_pointer f, s7_p_ii_t df) {add_opt_func(f, o_p_ii, (void *)df);} static s7_p_ii_t s7_p_ii_function(s7_pointer f) {return((s7_p_ii_t)opt_func(f, o_p_ii));} -#if (!WITH_GMP) +static void s7_set_d_7piid_function(s7_pointer f, s7_d_7piid_t df) {add_opt_func(f, o_d_7piid, (void *)df);} +static s7_d_7piid_t s7_d_7piid_function(s7_pointer f) {return((s7_d_7piid_t)opt_func(f, o_d_7piid));} + static void s7_set_p_dd_function(s7_pointer f, s7_p_dd_t df) {add_opt_func(f, o_p_dd, (void *)df);} -#endif +static void s7_set_p_d_function(s7_pointer f, s7_p_d_t df) {add_opt_func(f, o_p_d, (void *)df);} + +static s7_p_d_t s7_p_d_function(s7_pointer f) {return((s7_p_d_t)opt_func(f, o_p_d));} static s7_p_dd_t s7_p_dd_function(s7_pointer f) {return((s7_p_dd_t)opt_func(f, o_p_dd));} #define oo_slots(p) p->typ.vt[0] @@ -51197,26 +51570,8 @@ static s7_p_dd_t s7_p_dd_function(s7_poi #define oo_slot_offset 2 #define oo_type_offset 6 -#define OO_P 0 -#define OO_I 1 -#define OO_D 2 -#define OO_V 3 -#define OO_IV 4 -#define OO_FV 5 -#define OO_PV 6 -#define OO_R 7 -#define OO_H 8 -#define OO_S 9 -#define OO_BV 10 -#define OO_L 11 -#define OO_E 12 -#define OO_AV 13 -#define OO_TV 14 - -#if 0 -static const char *oo_types[15] = {"OO_P", "OO_I", "OO_D", "OO_V", "OO_IV", "OO_FV", "OO_PV", "OO_R", "OO_H", "OO_S", "OO_BV", "OO_L", "OO_E", "OO_AV", "OO_TV"}; -#endif - +enum {OO_P, OO_I, OO_D, OO_V, OO_IV, OO_FV, OO_PV, OO_R, OO_H, OO_S, OO_BV, OO_L, OO_E, OO_AV, OO_TV}; +/* static const char *oo_types[15] = {"OO_P", "OO_I", "OO_D", "OO_V", "OO_IV", "OO_FV", "OO_PV", "OO_R", "OO_H", "OO_S", "OO_BV", "OO_L", "OO_E", "OO_AV", "OO_TV"}; */ static const s7_int oo_to_s7[15] = {-1, 1LL << T_INTEGER, 1LL << T_REAL, 1LL << T_C_OBJECT, 1LL << T_INT_VECTOR, 1LL << T_FLOAT_VECTOR, 1LL << T_VECTOR, (1LL << T_REAL) + (1LL << T_RATIO) + (1LL << T_INTEGER), 1LL << T_HASH_TABLE, 1LL << T_STRING, 1LL << T_BYTE_VECTOR, 1LL << T_PAIR, 1LL << T_LET, @@ -51392,8 +51747,8 @@ static void oo_clear(opt_info *o) #define oo_line(p) #endif -#define oo_set_type_0(P, Size) oo_set_type_0_1(P, Size, __func__, __LINE__) -static opt_info *oo_set_type_0_1(opt_info *p, int size, const char *func, int line) +#define oo_set_type_0(P, Size) oo_set_type_0_0(P, Size, __func__, __LINE__) +static bool oo_set_type_0_0(opt_info *p, int size, const char *func, int line) { p->typ.vtype = 0; oo_slots(p) = 0; @@ -51401,8 +51756,9 @@ static opt_info *oo_set_type_0_1(opt_inf #if S7_DEBUGGING oo_func(p) = func; oo_line(p) = line; + oo_check(cur_sc, p); #endif - return(p); + return(true); } #if S7_DEBUGGING @@ -51417,8 +51773,8 @@ static void check_oo_type(int typ, int s /* slot value types stored from type_offset: type1 + (type2 << 4) | type3 + (type4 << 4) (leftmost=low index) */ -#define oo_set_type_1(P, Size, Slot1, Type1) oo_set_type_1_1(P, Size, Slot1, Type1, __func__, __LINE__) -static opt_info *oo_set_type_1_1(opt_info *p, int size, int slot1, int type1, const char *func, int line) +#define oo_set_type_1(P, Size, Slot, Type) oo_set_type_1_1(P, Size, Slot, Type, __func__, __LINE__) +static bool oo_set_type_1_1(opt_info *p, int size, int slot1, int type1, const char *func, int line) { check_oo_type(type1, slot1, 1, func, line); p->typ.vtype = 0; @@ -51430,12 +51786,13 @@ static opt_info *oo_set_type_1_1(opt_inf #if S7_DEBUGGING oo_func(p) = func; oo_line(p) = line; + oo_check(cur_sc, p); #endif - return(p); + return(true); } -#define oo_set_type_2(P, Size, Slot1, Slot2, Type1, Type2) oo_set_type_2_1(P, Size, Slot1, Slot2, Type1, Type2, __func__, __LINE__) -static opt_info *oo_set_type_2_1(opt_info *p, int size, int slot1, int slot2, int type1, int type2, const char *func, int line) +#define oo_set_type_2(P, Size, Slot1, Slot2, Type1, Type2) oo_set_type_2_2(P, Size, Slot1, Slot2, Type1, Type2, __func__, __LINE__) +static bool oo_set_type_2_2(opt_info *p, int size, int slot1, int slot2, int type1, int type2, const char *func, int line) { check_oo_type(type1, slot1, 1, func, line); check_oo_type(type2, slot2, 2, func, line); @@ -51450,12 +51807,13 @@ static opt_info *oo_set_type_2_1(opt_inf #if S7_DEBUGGING oo_func(p) = func; oo_line(p) = line; + oo_check(cur_sc, p); #endif - return(p); + return(true); } #define oo_set_type_3(P, Size, Slot1, Slot2, Slot3, Type1, Type2, Type3) oo_set_type_3_1(P, Size, Slot1, Slot2, Slot3, Type1, Type2, Type3, __func__, __LINE__) -static opt_info *oo_set_type_3_1(opt_info *p, int size, int slot1, int slot2, int slot3, int type1, int type2, int type3, const char *func, int line) +static bool oo_set_type_3_1(opt_info *p, int size, int slot1, int slot2, int slot3, int type1, int type2, int type3, const char *func, int line) { check_oo_type(type1, slot1, 1, func, line); check_oo_type(type2, slot2, 2, func, line); @@ -51474,13 +51832,14 @@ static opt_info *oo_set_type_3_1(opt_inf #if S7_DEBUGGING oo_func(p) = func; oo_line(p) = line; + oo_check(cur_sc, p); #endif - return(p); + return(true); } #define oo_set_type_4(P, Size, Slot1, Slot2, Slot3, Slot4, Type1, Type2, Type3, Type4) \ oo_set_type_4_1(P, Size, Slot1, Slot2, Slot3, Slot4, Type1, Type2, Type3, Type4, __func__, __LINE__) -static opt_info *oo_set_type_4_1(opt_info *p, int size, int slot1, int slot2, int slot3, int slot4, int type1, int type2, int type3, int type4, const char *func, int line) +static bool oo_set_type_4_1(opt_info *p, int size, int slot1, int slot2, int slot3, int slot4, int type1, int type2, int type3, int type4, const char *func, int line) { check_oo_type(type1, slot1, 1, func, line); check_oo_type(type2, slot2, 2, func, line); @@ -51502,8 +51861,9 @@ static opt_info *oo_set_type_4_1(opt_inf #if S7_DEBUGGING oo_func(p) = func; oo_line(p) = line; + oo_check(cur_sc, p); #endif - return(p); + return(true); } static void oo_resize(opt_info *o, int32_t new_size) @@ -51523,20 +51883,6 @@ static void oo_resize(opt_info *o, int32 #define oo_fixup_slots(sc, o) oo_fixup_slots_1(sc, o, __func__, __LINE__) static bool oo_fixup_slots_1(s7_scheme *sc, opt_info *o, const char *func, int line) { - /* TODO: local lets - * we need a way to recognize a local let and an end-of-body index, and the loop needs to call fixup_slots once the - * local let is in place (how to tell we're restoring rather than creating?) - * - * but opt_do_2 for example has the let built-in as o->v[2].p - * save the old sc->envir, attach the new and move to it, and go on, but when to pop out? o->sc->pc = o->v[5].i? - * where to store the stack of end-points? Or perhaps use recursion here: pass to fixup_slots_upto(...) - * none of the do-opts has outer vars to fixup, - * - * opc->v[0].fp is opt_do_2 (all do's are size=8, slots=0) - * oo_fixup_slots handles one opt_info struct, fixup_slots below handles all - * - * set oo_slots to 255? - */ int32_t i; for (i = 0; i < oo_slots(o); i++) { @@ -51662,7 +52008,9 @@ static opt_info *alloc_opo_1(s7_scheme * #if OPT_PRINT static bool return_false(s7_scheme *sc, s7_pointer expr, const char *func, int32_t line) { - fprintf(stderr, " %s%s[%d]%s: %s\n", BOLD_TEXT, func, line, UNBOLD_TEXT, DISPLAY_80(expr)); + if (expr) + fprintf(stderr, " %s%s[%d]%s: %s\n", BOLD_TEXT, func, line, UNBOLD_TEXT, DISPLAY_80(expr)); + else fprintf(stderr, " %s%s[%d]%s: false\n", BOLD_TEXT, func, line, UNBOLD_TEXT); return(false); } #else @@ -51670,8 +52018,70 @@ static bool return_false(s7_scheme *sc, #endif #define is_opt_int(p) is_t_integer(p) -#define is_opt_real(p) is_real(p) +static s7_pointer opt_integer_symbol(s7_scheme *sc, s7_pointer sym) +{ + if (is_symbol(sym)) + { + s7_pointer p; + p = symbol_to_slot(sc, sym); + if ((is_slot(p)) && + (is_opt_int(slot_value(p)))) + return(p); + } + return(NULL); +} + +static s7_pointer opt_real_symbol(s7_scheme *sc, s7_pointer sym) +{ + if (is_symbol(sym)) + { + s7_pointer p; + p = symbol_to_slot(sc, sym); + if ((is_slot(p)) && + (is_real(slot_value(p)))) + return(p); + } + return(NULL); +} + +static s7_pointer opt_float_symbol(s7_scheme *sc, s7_pointer sym) +{ + if (is_symbol(sym)) + { + s7_pointer p; + p = symbol_to_slot(sc, sym); + if ((is_slot(p)) && + (is_float(slot_value(p)))) + return(p); + } + return(NULL); +} + +static s7_pointer opt_simple_symbol(s7_scheme *sc, s7_pointer sym) +{ + s7_pointer p; + p = symbol_to_slot(sc, sym); + if ((is_slot(p)) && + (!has_methods(slot_value(p)))) + return(p); + return(NULL); +} + +static s7_pointer opt_types_match(s7_scheme *sc, s7_pointer check, s7_pointer sym) +{ + s7_pointer slot, checker; + checker = s7_symbol_value(sc, check); + slot = symbol_to_slot(sc, sym); + if (is_slot(slot)) + { + s7_pointer obj; + obj = slot_value(slot); + if (s7_apply_function(sc, checker, set_plist_1(sc, obj)) == sc->T) + return(slot); + } + return(NULL); +} static s7_double opt_float_any(s7_scheme *sc, s7_pointer expr) { @@ -51740,29 +52150,21 @@ static s7_int opt_i_s(void *p) {opt_info static bool opt_int_not_pair(s7_scheme *sc, s7_pointer car_x) { opt_info *opc; + s7_pointer p; if (is_opt_int(car_x)) { opc = alloc_opo(sc, car_x); opc->v[1].i = integer(car_x); opc->v[0].fi = opt_i_c; - oo_set_type_0(opc, 2); - oo_check(sc, opc); - return(true); + return(oo_set_type_0(opc, 2)); } - if (is_symbol(car_x)) + p = opt_integer_symbol(sc, car_x); + if (p) { - s7_pointer p; - p = symbol_to_slot(sc, car_x); - if ((is_slot(p)) && - (is_opt_int(slot_value(p)))) - { - opc = alloc_opo(sc, car_x); - opc->v[1].p = p; - opc->v[0].fi = opt_i_s; - oo_set_type_1(opc, 2, 1, OO_I); - oo_check(sc, opc); - return(true); - } + opc = alloc_opo(sc, car_x); + opc->v[1].p = p; + opc->v[0].fi = opt_i_s; + return(oo_set_type_1(opc, 2, 1, OO_I)); } return(return_false(sc, car_x, __func__, __LINE__)); } @@ -51784,8 +52186,7 @@ static s7_int opt_i_i_s(void *p) static s7_int opt_i_i_f(void *p) { - opt_info *o = (opt_info *)p; - opt_info *o1; + opt_info *o1, *o = (opt_info *)p; o1 = o->sc->opts[++(o->sc->pc)]; oo_rcheck(o->sc, o, 3, 0); return(o->v[2].i_i_f(o1->v[0].fi(o1))); @@ -51807,8 +52208,7 @@ static s7_int opt_i_7i_s(void *p) static s7_int opt_i_7i_f(void *p) { - opt_info *o = (opt_info *)p; - opt_info *o1; + opt_info *o1, *o = (opt_info *)p; o1 = o->sc->opts[++(o->sc->pc)]; oo_rcheck(o->sc, o, 3, 0); return(o->v[2].i_7i_f(o->sc, o1->v[0].fi(o1))); @@ -51830,8 +52230,7 @@ static s7_int opt_i_d_s(void *p) static s7_int opt_i_7d_f(void *p) { - opt_info *o = (opt_info *)p; - opt_info *o1; + opt_info *o1, *o = (opt_info *)p; o1 = o->sc->opts[++o->sc->pc]; oo_rcheck(o->sc, o, 3, 0); return(o->v[2].i_7d_f(o->sc, o1->v[0].fd(o1))); @@ -51839,8 +52238,7 @@ static s7_int opt_i_7d_f(void *p) static s7_int opt_i_7p_f(void *p) { - opt_info *o = (opt_info *)p; - opt_info *o1; + opt_info *o1, *o = (opt_info *)p; o1 = o->sc->opts[++o->sc->pc]; oo_rcheck(o->sc, o, 3, 0); return(o->v[2].i_7p_f(o->sc, o1->v[0].fp(o1))); @@ -51852,6 +52250,7 @@ static bool i_idp_ok(s7_scheme *sc, opt_ s7_i_7i_t func7 = NULL; s7_i_7d_t idf; s7_i_7p_t ipf; + s7_pointer p; int32_t start; start = sc->pc; @@ -51869,38 +52268,25 @@ static bool i_idp_ok(s7_scheme *sc, opt_ if (func) opc->v[0].fi = opt_i_i_c; else opc->v[0].fi = opt_i_7i_c; - oo_set_type_0(opc, 3); - oo_check(sc, opc); - return(true); + return(oo_set_type_0(opc, 3)); } - if (is_symbol(cadr(car_x))) + p = opt_integer_symbol(sc, cadr(car_x)); + if (p) { - opc->v[1].p = symbol_to_slot(sc, cadr(car_x)); - if ((is_slot(opc->v[1].p)) && - (is_integer(slot_value(opc->v[1].p)))) - { - if (func) - opc->v[0].fi = opt_i_i_s; - else opc->v[0].fi = opt_i_7i_s; - oo_set_type_1(opc, 3, 1, OO_I); - oo_check(sc, opc); - return(true); - } - /* return(return_false(sc, car_x, __func__, __LINE__)); */ + opc->v[1].p = p; + if (func) + opc->v[0].fi = opt_i_i_s; + else opc->v[0].fi = opt_i_7i_s; + return(oo_set_type_1(opc, 3, 1, OO_I)); } - else /* is pair arg */ + if (int_optimize(sc, cdr(car_x))) { - if (int_optimize(sc, cdr(car_x))) - { - if (func) - opc->v[0].fi = opt_i_i_f; - else opc->v[0].fi = opt_i_7i_f; - oo_set_type_0(opc, 3); - oo_check(sc, opc); - return(true); - } - pc_fallback(sc, start); + if (func) + opc->v[0].fi = opt_i_i_f; + else opc->v[0].fi = opt_i_7i_f; + return(oo_set_type_0(opc, 3)); } + pc_fallback(sc, start); } idf = s7_i_7d_function(s_func); if (idf) @@ -51910,43 +52296,21 @@ static bool i_idp_ok(s7_scheme *sc, opt_ { opc->v[1].x = s7_number_to_real(sc, cadr(car_x)); opc->v[0].fi = opt_i_d_c; - oo_set_type_0(opc, 3); - oo_check(sc, opc); - return(true); + return(oo_set_type_0(opc, 3)); } - if (is_symbol(cadr(car_x))) + p = opt_float_symbol(sc, cadr(car_x)); + if (p) { - opc->v[1].p = symbol_to_slot(sc, cadr(car_x)); - if (is_slot(opc->v[1].p)) - { - if (is_float(slot_value(opc->v[1].p))) - { - opc->v[0].fi = opt_i_d_s; - oo_set_type_1(opc, 3, 1, OO_D); - oo_check(sc, opc); - return(true); - } - if (float_optimize(sc, cdr(car_x))) - { - opc->v[0].fi = opt_i_7d_f; - oo_set_type_0(opc, 3); - oo_check(sc, opc); - return(true); - } - pc_fallback(sc, start); - } + opc->v[1].p = p; + opc->v[0].fi = opt_i_d_s; + return(oo_set_type_1(opc, 3, 1, OO_D)); } - else /* is pair arg */ + if (float_optimize(sc, cdr(car_x))) { - if (float_optimize(sc, cdr(car_x))) - { - opc->v[0].fi = opt_i_7d_f; - oo_set_type_0(opc, 3); - oo_check(sc, opc); - return(true); - } - pc_fallback(sc, start); + opc->v[0].fi = opt_i_7d_f; + return(oo_set_type_0(opc, 3)); } + pc_fallback(sc, start); } ipf = s7_i_7p_function(s_func); if (ipf) @@ -51955,13 +52319,11 @@ static bool i_idp_ok(s7_scheme *sc, opt_ if (cell_optimize(sc, cdr(car_x))) { opc->v[0].fi = opt_i_7p_f; - oo_set_type_0(opc, 3); - oo_check(sc, opc); - return(true); + return(oo_set_type_0(opc, 3)); } pc_fallback(sc, start); } - return(false); + return(return_false(sc, car_x, __func__, __LINE__)); } @@ -51983,8 +52345,7 @@ static s7_int ivref_7pi_ss(void *p) static s7_int opt_i_7pi_sf(void *p) { - opt_info *o = (opt_info *)p; - opt_info *o1; + opt_info *o1, *o = (opt_info *)p; o1 = o->sc->opts[++o->sc->pc]; oo_rcheck(o->sc, o, 4, 1); return(o->v[3].i_7pi_f(o->sc, slot_value(o->v[1].p), o1->v[0].fi(o1))); @@ -52000,63 +52361,48 @@ static bool i_7pi_ok(s7_scheme *sc, opt_ sig = c_function_signature(s_func); if (is_pair(sig)) { - s7_pointer arg1, arg2; + s7_pointer arg1, arg2, slot; int32_t start; start = sc->pc; arg1 = cadr(car_x); arg2 = caddr(car_x); if ((is_symbol(cadr(sig))) && - (is_symbol(arg1))) + (is_symbol(arg1)) && + (slot = opt_types_match(sc, cadr(sig), arg1))) { - s7_pointer obj, checker; - checker = s7_symbol_value(sc, cadr(sig)); - obj = s7_symbol_value(sc, arg1); - if (s7_apply_function(sc, checker, set_plist_1(sc, obj)) == sc->T) - { - opc->v[1].p = symbol_to_slot(sc, arg1); - if (is_slot(opc->v[1].p)) - { - if ((car(car_x) == sc->int_vector_ref_symbol) && - ((!is_int_vector(slot_value(opc->v[1].p))) || - (vector_rank(slot_value(opc->v[1].p)) > 1))) - return(return_false(sc, car_x, __func__, __LINE__)); - - opc->v[3].i_7pi_f = pfunc; - if (is_symbol(arg2)) - { - opc->v[2].p = symbol_to_slot(sc, arg2); - if ((is_slot(opc->v[2].p)) && - (is_opt_int(slot_value(opc->v[2].p)))) - { - opc->v[0].fi = opt_i_7pi_ss; - oo_set_type_2(opc, 4, 1, 2, OO_P, OO_I); - if ((car(car_x) == sc->int_vector_ref_symbol) && - (is_step_end(opc->v[2].p)) && - (denominator(slot_value(opc->v[2].p)) <= vector_length(slot_value(opc->v[1].p)))) - { - opc->v[0].fi = ivref_7pi_ss; - opc->v[3].i_7pi_f = int_vector_ref_unchecked; - } - oo_check(sc, opc); - return(true); - } - } - if (int_optimize(sc, cddr(car_x))) - { - opc->v[0].fi = opt_i_7pi_sf; - oo_set_type_1(opc, 4, 1, OO_P); - oo_check(sc, opc); - return(true); - } - pc_fallback(sc, start); + s7_pointer p; + opc->v[1].p = slot; + if ((car(car_x) == sc->int_vector_ref_symbol) && + ((!is_int_vector(slot_value(slot))) || + (vector_rank(slot_value(slot)) > 1))) + return(return_false(sc, car_x, __func__, __LINE__)); + + opc->v[3].i_7pi_f = pfunc; + p = opt_integer_symbol(sc, arg2); + if (p) + { + opc->v[2].p = p; + opc->v[0].fi = opt_i_7pi_ss; + if ((car(car_x) == sc->int_vector_ref_symbol) && + (is_step_end(opc->v[2].p)) && + (denominator(slot_value(opc->v[2].p)) <= vector_length(slot_value(opc->v[1].p)))) + { + opc->v[0].fi = ivref_7pi_ss; + opc->v[3].i_7pi_f = int_vector_ref_unchecked; } + return(oo_set_type_2(opc, 4, 1, 2, OO_P, OO_I)); } - else return(return_false(sc, car_x, __func__, __LINE__)); + if (int_optimize(sc, cddr(car_x))) + { + opc->v[0].fi = opt_i_7pi_sf; + return(oo_set_type_1(opc, 4, 1, OO_P)); + } + pc_fallback(sc, start); } } } - return(false); + return(return_false(sc, car_x, __func__, __LINE__)); } /* -------- i_ii -------- */ @@ -52125,8 +52471,7 @@ static s7_pointer opt_p_ii_ss_add(void * static s7_int opt_i_ii_cf(void *p) { - opt_info *o = (opt_info *)p; - opt_info *o1; + opt_info *o1, *o = (opt_info *)p; o1 = o->sc->opts[++o->sc->pc]; oo_rcheck(o->sc, o, 4, 0); return(o->v[3].i_ii_f(o->v[1].i, o1->v[0].fi(o1))); @@ -52134,17 +52479,23 @@ static s7_int opt_i_ii_cf(void *p) static s7_int opt_i_ii_sf(void *p) { - opt_info *o = (opt_info *)p; - opt_info *o1; + opt_info *o1, *o = (opt_info *)p; o1 = o->sc->opts[++o->sc->pc]; oo_rcheck(o->sc, o, 4, 1); return(o->v[3].i_ii_f(integer(slot_value(o->v[1].p)), o1->v[0].fi(o1))); } +static s7_int opt_i_ii_sf_add(void *p) +{ + opt_info *o1, *o = (opt_info *)p; + o1 = o->sc->opts[++o->sc->pc]; + oo_rcheck(o->sc, o, 4, 1); + return(integer(slot_value(o->v[1].p)) + o1->v[0].fi(o1)); +} + static s7_int opt_i_ii_ff(void *p) { - opt_info *o = (opt_info *)p; - opt_info *o1; + opt_info *o1, *o = (opt_info *)p; s7_int i1; o1 = o->sc->opts[++o->sc->pc]; i1 = o1->v[0].fi(o1); @@ -52153,11 +52504,9 @@ static s7_int opt_i_ii_ff(void *p) return(o->v[3].i_ii_f(i1, o1->v[0].fi(o1))); } -#if (!WITH_GMP) static s7_int opt_i_ii_fc(void *p) { - opt_info *o = (opt_info *)p; - opt_info *o1; + opt_info *o1, *o = (opt_info *)p; o1 = o->sc->opts[++o->sc->pc]; oo_rcheck(o->sc, o, 4, 0); return(o->v[3].i_ii_f(o1->v[0].fi(o1), o->v[2].i)); @@ -52165,8 +52514,7 @@ static s7_int opt_i_ii_fc(void *p) static s7_int opt_i_ii_fc_add(void *p) { - opt_info *o = (opt_info *)p; - opt_info *o1; + opt_info *o1, *o = (opt_info *)p; o1 = o->sc->opts[++o->sc->pc]; oo_rcheck(o->sc, o, 4, 0); return(o1->v[0].fi(o1) + o->v[2].i); @@ -52174,8 +52522,7 @@ static s7_int opt_i_ii_fc_add(void *p) static s7_pointer opt_p_ii_fc_add(void *p) { - opt_info *o = (opt_info *)p; - opt_info *o1; + opt_info *o1, *o = (opt_info *)p; o1 = o->sc->opts[++o->sc->pc]; oo_rcheck(o->sc, o, 4, 0); return(make_integer(o->sc, o1->v[0].fi(o1) + o->v[2].i)); @@ -52183,8 +52530,7 @@ static s7_pointer opt_p_ii_fc_add(void * static s7_int opt_i_7ii_f