on echo;
% This file can be run to turn bits of the REDUCE source code
% into C so that this C can be compiled and linked in to make a
% customised CSL executable that will red REDUCE faster.
%
% Run this using slowr37.img to select code to compile into C.
% The functions to be compiled are extracted from a file "profile.dat"
% that was created by "profile.red".
%
symbolic;
% Three major parameters are available:
%
% fnames a list of files to create. Making the list longer (or
% shorter) changes the amount of C that can be created.
% The CSL source code has to know how many there are, and
% its current default is for 12 files.
%
% size_per_file
% this guides the compiler about how much to put in each
% generated file, where the value 7000 results in each
% file of generated C being in the range 120 to 150 Kbytes.
%
% force_count indicates how many functions from alg.tst statistics should
% be included before anything else.
%
%
% Also if "how_many" is set then this will limit the total number of
% functions that are compiled into C. Since I expect to pass that via a
% command line "-dhow_many=362" etc I allow for it being a string
% not a number to start with. In ordinary circumstances this will not be
% used, however it has proved INVALUABLE when tracking down cases where
% compilation into C causes changes in behaviour... how_many can be used
% with a binary-chop selection process to discover exactly which function
% causes upset when compiled into C. Of course in release quality code I
% hope there are no such cases!
global '(fnames size_per_file force_count how_many);
fnames := '("u01" "u02" "u03" "u04" "u05"
"u06" "u07" "u08" "u09" "u10"
"u11" "u12");
size_per_file := 7000;
force_count := 350;
if not boundp 'how_many then how_many := 1000000
else << how_many := compress explodec how_many;
if not numberp how_many then how_many := 1000000 >>;
on comp;
% First update the patch information (if needbe).
load!-module 'remake;
ensure_patches_are_up_to_date();
% Here I need to consider the issue of patches. First consider patches that
% had been in force when "profile.red" was run. In such cases a patched
% function f1 has an associated replacement f1_123456789 (the numeric suffix
% is a checksum on the new definition) and when the profile job was run
% this replacement will have had its definition copied to f1. The way in
% which CSL's mapstore function extracts counts will mean that the
% thing in profile.dat relate to f1_123456789.
% Usually things in profile.dat are in the form
% (function_name . checksum_of_definition)
% but for these patched things I will instead record
% (original_function_name package_involved)
% This can be distinguished because it has a symbol not a number as
% the second component. To make this possible each patch function
% f1_123456789 would have to have this information attached to it
% when the profiling job was run.
%
% But I suppose have now obtained a newer version of the patches file. So
% now the correct patch for f1 will be f1_abcdef. If f1 was in one of the
% REDUCE core packages (eg "alg") then both the functions f1_123456789 and
% f1_abcdef will be in memory now, but it will be the latter that will
% have been copied to plain old f1. In other cases f1_123456789 will now
% have been totally lost and the definition of f1_abcdef will be in the
% patches module. Furthermore the new patches file may patch another
% function f2 that had not previously been subject to patching, but
% that had been selected for compilation into C. And in a truly bad
% case the complete REDUCE sources will contain several functions named
% f2 and of course the patches file identifies which one it is interested
% in by the name of the package it is in.
%
% The response to all this I will use here is intended to make life
% reasonably SIMPLE for me in a complicated situation. So I first
% collect the set of names that I think need compiling into C. Then I
% grab a list of the names of things defined in the current patches file.
% If a function in the paches file has a name similar enough (!) to one that
% I have already decided to compile into C then I will schedule it for
% compilation into C too. Because of the hash suffix added to names in the
% patches file defining a C version having those things present in the Lisp
% kernel should never be a problem - after all the patches file itself is
% intended to be loaded all the time. So the main down-side of this is
% that I will sometimes find that I have compiled into C either patch
% versions of a function when it was another version of that code that was
% time-critical or that I have compiled into C two generations of
% patch function. These waste opportunity and space by having some
% things compiled into C that might not really justify that, but this
% seems a modest cost.
fluid '(w_reduce requests);
w_reduce := requests := nil;
% I make a list of all the functions that profile data suggests that
% I should compile into C. The master copy of the profile data is
% usually expected to be in "../csl-c", but I allow a copy in the
% current directory (which is where the profiling process leaves it).
symbolic procedure read_profile_data file;
begin
scalar w0, w1;
if not errorp(w0 := errorset(list('open, file, ''input), nil, nil)) then <<
w0 := rds car w0;
while not errorp (w1 := errorset('(read), nil, nil)) and
not eqcar(w1, !$eof!$) do
requests := car w1 . requests;
% The data structure read in here will be of the form
% ((module-name f-name1 f_name2 ...) (module-name ...) ...)
% where within each module the requested functions have been listed in
% order of priority.
close rds w0 >>
end;
% I read from the current directory only if I do not find anything
% in the csl-c one.
off echo;
read_profile_data "../csl-c/profile.dat";
if null requests then read_profile_data "profile.dat";
on echo;
% As a fairly shameless hack I am going to insist on compiling ALL the
% things that the "alg" test uses. That is because this one test
% fiel has been used for many years to give a single performance
% figure for REDUCE. In fact it is not too bad to pay lots of
% attention to it since it exercises the basic core algebra and so what is
% good for it is good for quite a lot of everybody else. However by
% tuning this selection process you can adjust the way REDUCE balances
% its speed in different application areas.
w_reduce := assoc('alg, requests)$
requests := for each x in delete(w_reduce, requests) collect cdr x$
w_reduce := reverse cdr w_reduce$
d := length w_reduce - force_count;
if d > 0 then for i := 1:d do w_reduce := cdr w_reduce;
length w_reduce;
% Now I will merge in suggestions from all other modules in
% breadth-first order of priority
% Ie if I have modules A, B, C and D (with A=alg) and each has in it
% functions a1, a2, a3 ... (in priority odder) then I will make up a list
% here that goes
%
% a1 a2 a3 ... an b1 c1 d2 b2 c2 d2 b3 c3 d3 b4 c4 d4 ...
%
% so that the first n items from A get priority and after that B, C and D
% will get about balanced treatment if I have to truncate the list at
% some stage.
symbolic procedure membercar(a, l);
if null l then nil
else if a = caar l then t
else membercar(a, cdr l);
fg := t;
while fg do <<
fg := nil;
for each x on requests do
if car x then <<
if k := assoc(caaar x, w_reduce) then <<
if not (cadr k = cadaar x) then <<
prin caaar x; printc " has multiple definition";
princ " keep version with checksum: "; print cadr k;
princ " ignore: "; print cadaar x;
terpri() >> >>
% ORDP is a special case because I have put a version of it into the
% CSL kernel by hand, and any redefinition here would be unfriendly and
% might clash with that.
else if caaar x = 'ordp then printc "Ignoring ORDP (!)"
else w_reduce := caar x . w_reduce;
fg := t;
rplaca(x, cdar x) >> >>;
% Now I scan all pre-compiled modules to recover source versions of the
% selected REDUCE functions. The values put as load!-source properties
% are checksums of the recovered definitions that I would be prepared
% to accept.
for each n in w_reduce do put(car n, 'load!-source, cdr n);
w_reduce := for each n in w_reduce collect car n$
for each m in library!-members() do load!-source m;
% Now deal with patches...
load!-source := t;
patch!-functions := load!-source 'patches;
% Some of the functions just collected are not patches for bits of REDUCE
% but are the code that installs the patches. I do not worry too much
% about that here.
% Now I will scan down w_reduce (the list of all things to be compiled into C)
% and if that contains an entry either f1 or f1_123456789 and there is
% an entry f2_abcdef in the list of patch-functions then I will
% insert f2_abcdef into the list of things to be compiled into C just
% next to plain f2 or f2_123456789.
%
% The way I do this will often set up a few false-matches but the cost of
% them is just that some unimportant things will get compiled into C.
global '(tag!-chars);
tag!-chars := explodec "0123456789abcdefghijklmnopqrstuvwxyz";
symbolic procedure trim!-suffix name;
begin
scalar w;
w := reverse explode name;
if eqcar(w, '!_) then w := cdr w;
if null w or not member(car w, tag!-chars) then return nil;
w := cdr w;
while w and member(car w, tag!-chars) do w := cdr w;
if not eqcar(w, '!_) then return nil;
w := cdr w;
if null w then return nil
else return compress reverse w
end;
w := w_reduce$
w_reduce := nil;
while w do <<
w_reduce := car w . w_reduce;
p := trim!-suffix car w;
for each n in patch!-functions do
if not (n = car w) and
p and
not (n member w_reduce) and
p = trim!-suffix n then <<
w_reduce := n . w_reduce;
princ "+++ Also C-compile "; prin n; princ " as match for ";
prin car w; princ ": root is "; print p >>;
w := cdr w >>;
verbos nil;
global '(rprifn!*);
load_package ccomp;
on fastfor, fastvector, unsafecar;
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));
<<
count := 0;
while fnames do begin
scalar name, bulk;
name := car fnames;
princ "About to create "; printc name;
c!:ccompilestart(name, "../csl-c");
bulk := 0;
while bulk < size_per_file and w_reduce and how_many > 0 do begin
scalar name, defn;
name := car w_reduce;
if null (defn := get(name, '!*savedef)) then <<
princ "+++ "; prin name; printc ": no saved definition found";
w_reduce := cdr w_reduce >>
else <<
bulk := listsize(defn, bulk);
if bulk < size_per_file then <<
c!:ccmpout1 ('de . name . cdr defn);
how_many := how_many - 1;
count := count + 1;
w_reduce := cdr w_reduce >> >> 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.
if null w_reduce then printc "No more functions need compiling into C"
else while bulk < 50 and w_reduce do
begin
name := car w_reduce;
if null (defn := get(name, '!*savedef)) then <<
princ "+++ "; prin name; printc ": no saved definition found";
w_reduce := cdr w_reduce >>
else <<
bulk := bulk+1;
print name;
w_reduce := cdr w_reduce >> end;
terpri();
prin count; printc " functions compiled into C";
nil >>;
quit;