123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386 |
- %
- % Run using smallr35 to select code to compile into C.
- % I run "reduce.tst" as the main test to tune against, but also
- % use data collected (elsewhere) to ensure that the most heavily
- % used functions in various other tests are catered for.
- %
- %
- % I recompile the patches module in case it has changed since the main
- % image file that I am using was created.
- %
- on comp, backtrace;
- in "../cslsrc/patches.red"$
- % It is a misery that the REDUCE test files do not tidy up after themselves,
- % so if I want to run several in the same job I have to put well-judged
- % CLEAR statements between. If I miss out some of these almost any
- % curious behaviour might arise.
- on echo;
- lisp verbos 3;
- % Here I set up a list that documents what appear to be the most
- % heavily used few functions in each of a number of the test files.
- % I will force these to be compiled into C regardless of what is in the
- % benchmark files that I process as well
- lisp (force_these := '(
- % Reduce.tst
- getel1 simpcar noncomp ordop delcp multd addf terminalp
- multf prin2!* !*ssave getrtypeor getrtype timesip getrtype2
- exchk simp ordad getel readch1
- % Int.tst
- ordop reorder multd addf delall powers0 multf maxdeg
- noncomp rmultpf quotf1 quotf negf addd raddf degr
- !*n2f !*d2q minusf ordpp
- % Factor.tst
- !*n2f adjoin!-term multiply!-by!-constant!-mod!-p plus!-mod!-p
- remainder!-in!-vector mksp getpower addf multd times!-term!-mod!-p
- multf listsum to noncomp times!-mod!-p fkern clear!-column addd
- minus!-mod!-p multdm
- % Decompos.tst
- freeof freeofl !*n2f smember addf ordop multd multf
- to adjoin!-term noncomp addd multdm adddm mkspm sub2chk
- multiply!-by!-constant!-mod!-p plus!-mod!-p ordpp exchk
- % Limits.tst
- ps!:getv ps!:last!-term ps!:order ps!:get!-term ps!:evaluate exchk
- multsq retimes1 prepf1 quotf addsq prepf ps!:times!-erule replus
- retimes ps!:putv !*d2q exchk1 prepsq prepd
- % Matrix.tst
- addf multd !*n2f multf addd to c!:ordxp c!:ordexp noncomp
- adddm negf c!:extadd ordop quotf1 c!:extmult mkspm sub2chk
- c!:ordexn scprint multdm
- % Groebner.tst
- evlexcomp vevzero!?1 vevmtest!? bcnumtimes evcomp bcint2op
- bcprod vevcan0 evsum quotf evzero!? diplength groebsearchinlist
- listsum exchk multd reorder retimes1 vevmaptozero1 ordop
- % Roots.tst
- CSL_normbf CSL_timbf round!:mt round!:last plus!: divide!:
- conv!:mt ncoeffs gftimesn difference!: plubf terminalp
- lastpair abs!: gfplusn gfrsq cut!:mt gfdot readch1 gbfdot
- % Solve.tst
- ordop freeof freeofl smember addf multd multf !*n2f noncomp
- negf to exchk ordpp vevmtest!? addd multdm retimes1 reorder
- adddm mkspm
- % Compact.tst
- termsf addf !*n2f addd multd multf noncomp to
- adddm negf mkspm sub2chk multdm kernels1 red!-weight1
- !:minus nonzero!-length ordop mv!-pow!-!+ ordpp
- % Gcd.tst
- !*n2f adjoin!-term multiply!-by!-constant!-mod!-p
- plus!-mod!-p mksp addf getpower multd addd
- times!-term!-mod!-p times!-mod!-p ordop multf
- fkern noncomp powers2 to adddm raddf reorder
- % Excalc.tst
- ordop reorder delall maxdeg powers0 rmultpf raddf
- quotf to quotf1 lastpair reordop addf multf quotfm
- exchk ordpp noncomp negf multd
- % Tps.tst
- ps!:getv ps!:last!-term ps!:order quotf exchk
- ps!:get!-term retimes1 prepf1 prepf minusf multsq
- ps!:evaluate replus revpr retimes gcdf lnc quotf1
- terminalp scprint
- % Taylor.tst
- tayexp!-plus2 gcdfd1 quotf tayexp!-greaterp multd
- exceeds!-order lastpair tayexp!-difference addf
- gcdf minusf quotf1 multf multsq gcdf1 gcdfd add!-degrees
- lnc terminalp ordop
- % Sum.tst
- addf noncomp multf multd to !*n2f addd ordop reorder
- adddm multdm mkspm sub2chk lastpair raddf ordpp exchk
- negf rmultpf quotf1
- % Algint.tst
- addf multd ordop reorder multf noncomp delall
- powers0 to !*n2f addd quotf1 maxdeg rmultpf
- negf adddm subs2f1 depends ldepends raddf
- % Scope.tst
- lastpair terminalp initbrsea testred initwght
- token prin2x readch1 numberofocc downwght1 pnthxzz
- lispeval smember inshisto delcp pprin2
- downwght toknump init
- % Gentran.tst
- lastpair terminalp pprin2 readch1 token prin2x
- listp exchk prepf1 retimes1 delcp ordop nconc!*
- toknump mkvar lispeval exchk1 noncomp reversip!*
- % Arnum.tst
- !*n2f multd addf adjoin!-term remainder!-in!-vector
- multf to addd rnzerop!: multdm noncomp rnequiv adddm
- rnonep!: int!-equiv!-chk times!-in!-vector mkrn
- plus!-mod!-p multiply!-by!-constant!-mod!-p mksp
- % Elem.tst
- delcp terminalp readch1 exchk sinitl striptag
- s!:prinl1 CSL_normbf convprec!* prin2x token
- replus convchk prepf retimes1 errorset!* errorp round!:mt
- % Complex.tst
- !*n2f CSL_normbf terminalp multd remainder!-in!-vector
- adjoin!-term round!:mt addf readch1 round!:last
- multiply!-by!-constant!-mod!-p scprint prin2!*
- gizerop!: mkgi times!-in!-vector addd striptag
- % Rounded.tst
- terminalp smemql CSL_normbf readch1 s!:assoc
- round!:mt round!:last prin2!* !*ssave token
- prin2x exchk scprint convprec divide!: sinitl getrtype
- round!*
- % Math.tst
- terminalp readch1 prin2x token delcp reversip!* mkvar
- token1 toknump convertmode scan formc arrayp
- eolcheck xread1 getrmacro macrochk form1
- % Spde.tst
- ordop ldepends depends exchk prepf1 ordpp
- retimes1 multsq ordad addf difff nconc!* exchk1
- addsq !*d2q multd simpcar multf sqchk
- % Avector.tst
- prin2!* negnumberchk update!-pline ordop maprint
- putpline noncomp multf layout!-formula scprint
- prepf1 addf quotf1 oprin exchk negf retimes1
- nconc!* to exptpri
- % Orthovec.tst
- exchk prepf1 retimes1 nconc!* exchk1 prepf retimes
- getrtype getrtypeor reval replus simpcar prepd
- getrtype2 sqchk reval2 simp prepsqxx !*ssave
- % Specfn.tst
- CSL_normbf round!:mt subs3f round!:last exchk
- revpr quotsq convprec!* !*ssave striptag subs3q
- divide!: simpcar subs3f1 getrtype2 getrtype multsq
- addsq convchk
- ))$
- symbolic procedure cf(p, q);
- (float caddr p/float cadr p) > (float caddr q/float cadr q);
- symbolic mapstore 4; % reset counts;
- in "../xmpl/reduce.tst";
- symbolic (w_reduce := sort(mapstore 2, function cf))$
- clear a, xx, yy, zz, k1, ki, kf, p1, pf,
- ei, ef, ki, kf, p1, pf, gp, ix, iy, iz,
- p2, p3, p4, qi, q2, ga, gb, w;
- % The lines commented out thus "%---" are a prototype of how to
- % include one or more further test files in this benchmark/tuning
- % suite.
- %--- symbolic mapstore 4;
- %---
- %--- in "../xmpl/int.tst";
- %---
- %--- symbolic (w_int := sort(mapstore 2, function cf))$
- %---
- %--- clear f1s, a, z, u, v;
- symbolic;
- fluid '(w);
- w := w_reduce$
- symbolic procedure top_twenty x;
- begin
- scalar y;
- for i := 1:20 do
- if x then << y := car x . y; x := cdr x >>;
- return y
- end;
- symbolic procedure addin r;
- begin
- scalar v;
- v := assoc(car r, w);
- if not v then w := r . w
- else w := list(car r, cadr r + cadr v, caddr r + caddr v) . delete(v, w);
- return nil
- end;
- %--- w_int := top_twenty w_int$
- for i := 1:20 do <<
- %--- if w_int then << addin car w_int; w_int := cdr w_int >>;
- nil >>;
- z := w$ w := nil;
- for each v in z do begin
- scalar name, name1;
- name := car v;
- name1 := symbol!-env name;
- if not atom name1 then <<
- name1 := cdr name1;
- if vectorp name1 then name := getv(name1, 0) >>;
- addin list(name, cadr v, caddr v) end;
- w := sort(w, function cf)$
- for each fn in force_these do begin
- scalar name1;
- name1 := symbol!-env fn;
- if not atom name1 and vectorp cdr name1 then fn := getv(cdr name1, 0);
- addin list(fn, 0, 0);
- force_these := cdr force_these end;
- total_bytes_executed := 0;
- for each v in w do total_bytes_executed := total_bytes_executed + caddr v;
- symbolic procedure listsize(x, n);
- if null x then n
- else if atom x then n+1
- else listsize(cdr x, listsize(car x, n+1));
- fnames := '("u01" "u02" "u03" "u04" "u05"
- "u06" "u07" "u08" "u09" "u10"
- "u11" "u12");
- size_per_file := 4300;
- symbolic procedure get!-saved m;
- << loaded!-packages!* := nil;
- load!-package m;
- for each x in oblist() do
- if not atsoc(x, w) then remprop(x, '!*savedef)
- >>;
- % With !*savedef = '!*savedef when I load a module I do not load the
- % executable code in it - just the saved function definitions on
- % property lists (also I execute any code in the file that is not
- % just defining a function). Since some modules define functions
- % that they then call, I need to define suitable placeholders here.
- symbolic procedure set!-teeny!-primes(); nil;
- symbolic procedure initio(); nil;
- symbolic procedure find!!flim(); nil;
- algebraic procedure get!-eulers!-constant n; 0;
- % The taylor module defines and uses a macro (taylor!:) in a way that
- % seems to make it hard for me to handle using the general mechanism
- % I use below.
- get!-saved 'taylor;
- !*savedef := '!*savedef;
- <<
- % I load the files here with the largest module first. This is intended
- % to ease memory pressure. But I put the core system last so that
- % definitions in it take precedense over those in optional modules.
- get!-saved 'algint;
- % get!-saved 'int;
- get!-saved 'scope;
- % get!-saved 'gentran;
- get!-saved 'factor;
- % get!-saved 'ezgcd;
- get!-saved 'roots;
- get!-saved 'excalc;
- get!-saved 'groebnr2;
- % get!-saved 'groebner;
- % get!-saved 'dipoly;
- get!-saved 'solve;
- get!-saved 'specfn2;
- % get!-saved 'specfn;
- % get!-saved 'specfaux;
- get!-saved 'numeric;
- get!-saved 'matrix;
- % get!-saved 'spde; Not loaded because of function clashes
- get!-saved 'misc;
- % get!-saved 'tps;
- get!-saved 'rlisp88;
- get!-saved 'arnum;
- get!-saved 'odesolve;
- % get!-saved 'rcref; Not loaded because I will not worry about speed here
- % get!-saved 'avector; Not loaded because of function clashes
- get!-saved 'hephys;
- % get!-saved 'orthovec; Not loaded because of function clashes
- get!-saved 'compact;
- % get!-saved 'rprint; Not loaded because I will not worry about speed here
- % get!-saved 'cedit; Not loaded because I will not worry about speed here
- % get!-saved 'pretty; Not loaded because I will not worry about speed here
- get!-saved 'module;
- % Now do some tidying up - to try to free up some memory
- for each x in oblist() do
- for each y in '(simpfn dfn opmtch klist kvalue avalue) do
- remprop(x, y);
- % I reload the most basic bits of REDUCE once again to ensure that the
- % definitions that I will compile into C come from these modules even
- % if some other package redefines something critical.
- get!-saved 'rlisp;
- get!-saved 'cslrend;
- get!-saved 'poly;
- get!-saved 'alg;
- get!-saved 'arith;
- get!-saved 'mathpr;
- off echo;
- in "../cslsrc/patches.red"$
- on echo;
- !*savedef := nil;
- set!-print!-precision 4;
- benefit := 0;
- symbolic verbos nil;
- global '(rprifn!*);
- load_package ccomp;
- on fastfor, fastvector, unsafecar;
- while fnames do begin
- scalar bulk;
- princ "About to create "; printc car fnames;
- c!:ccompilestart car fnames;
- bulk := 0;
- while bulk < size_per_file and w do begin
- scalar name, defn, value;
- name := caar w;
- value := float caddar w/((1.0+sqrt float cadar w)*1000.0);
- defn := get(name, '!*savedef);
- remprop('name, '!*savedef); % Save a little space.
- if null defn then <<
- princ "+++ "; prin name; printc ": no saved definition found";
- w := cdr w >>
- else <<
- bulk := listsize(defn, bulk);
- if bulk < size_per_file then <<
- benefit := benefit + caddar w;
- prin name; ttab 30; prin value;
- ttab 45; print (100.0*float benefit/float total_bytes_executed);
- c!:ccmpout1 ('de . name . cdr defn);
- w := cdr w >> >> end;
- eval '(c!-end);
- fnames := cdr fnames
- end;
- terpri();
- printc "*** End of compilation from REDUCE into C ***";
- terpri();
- bulk := 0;
- % I list the next 50 functions that WOULD get selected - just for interest.
- while bulk < 50 and w do
- begin
- name := caar w;
- value := float caddar w/((1.0+sqrt float cadar w)*1000.0);
- defn := get(name, '!*savedef);
- if null defn then <<
- princ "+++ "; prin name; printc ": no saved definition found";
- w := cdr w >>
- else <<
- bulk := bulk+1;
- benefit := benefit + caddar w;
- prin name; ttab 30; prin value;
- ttab 45; print (100.0*float benefit/float total_bytes_executed);
- w := cdr w >> end;
- nil >>;
- quit;
|