Artifact 0388515151d689512c6eb7134ff1cab703b8cee49764035cb9e2f486c796e552:
- Executable file
r36/cslsrc/select36.red
— part of check-in
[f2fda60abd]
at
2011-09-02 18:13:33
on branch master
— Some historical releases purely for archival purposes
git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/trunk/historical@1375 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 12917) [annotate] [blame] [check-ins using] [more...]
% % 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 "../src/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 spur0 kahane spurr sprgen1 % Int.tst ordop reorder multd addf 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 evcompless!? evcomp evlexcomp evinvlexcomp evgradlexcomp evrevgradlexcomp evtdeg evgradgradcomp evgradgradcomp1 evpartdeg evpartdeg1 evgradrevgradcomp evgradrevgradcomp1 evlexgradlexcomp evlexgradlexcomp1 evlexrevgradlexcomp evlexrevgradlexcomp1 evweightedcomp evweightedcomp1 evgradedinit evgradedcomp ev!-gamma vevzero!?1 vevmtest!? bcint2op bcprod vevcan0 evsum quotf evzero!? diplength groebsearchinlist listsum exchk multd reorder retimes1 vevmaptozero1 ordop evrevgradlexcomp evtdeg bccheckz buch!-vevdivides!? bcsum dipilcomb1 % 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 gcdfd1 quotf multd lastpair addf gcdf minusf quotf1 multf multsq gcdf1 gcdfd 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 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 !: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 % Misc modzerop!: modonep!: !*modular2f general!-modular!-plus general!-modular!-times modplus!: modtimes!: dcombine ))$ 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, eei, 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 := 5000; 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; 0; symbolic procedure root_of_eval u; '!*xxx!*; % 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 'roots2; % get!-saved 'roots; get!-saved 'excalc; get!-saved 'groebnr2; % get!-saved 'groebner; % get!-saved 'dipoly; get!-saved 'solve; % get!-saved 'matrix; get!-saved 'specfn2; % get!-saved 'specfn; % get!-saved 'specfaux; get!-saved 'specbess; get!-saved 'numeric; % 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 "../src/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;