1#! /usr/bin/perl -w 2 3# Copyright 2000, 2001, 2002 Free Software Foundation, Inc. 4# 5# This file is part of the GNU MP Library. 6# 7# The GNU MP Library is free software; you can redistribute it and/or modify 8# it under the terms of the GNU Lesser General Public License as published by 9# the Free Software Foundation; either version 3 of the License, or (at your 10# option) any later version. 11# 12# The GNU MP Library is distributed in the hope that it will be useful, but 13# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 14# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 15# License for more details. 16# 17# You should have received a copy of the GNU Lesser General Public License 18# along with the GNU MP Library. If not, see http://www.gnu.org/licenses/. 19 20 21# Usage: cd $builddir/tune 22# perl $srcdir/tune/many.pl [-t] <files/dirs>... 23# 24# Output: speed-many.c 25# try-many.c 26# Makefile.many 27# 28# Make alternate versions of various mpn routines available for measuring 29# and testing. 30# 31# The $srcdir and $builddir in the invocation above just means the script 32# lives in the tune source directory, but should be run in the tune build 33# directory. When not using a separate object directory this just becomes 34# 35# cd tune 36# perl many.pl [-t] <files/dirs>... 37# 38# 39# SINGLE FILES 40# 41# Suppose $HOME/newcode/mul_1_experiment.asm is a new implementation of 42# mpn_mul_1, then 43# 44# cd $builddir/tune 45# perl $srcdir/tune/many.pl $HOME/newcode/mul_1_experiment.asm 46# 47# will produce rules and renaming so that a speed program incorporating it 48# can be built, 49# 50# make -f Makefile.many speed-many 51# 52# then for example it can be compared to the standard mul_1, 53# 54# ./speed-many -s 1-30 mpn_mul_1 mpn_mul_1_experiment 55# 56# An expanded try program can be used to check correctness, 57# 58# make -f Makefile.many try-many 59# 60# and run 61# 62# ./try-many mpn_mul_1_experiment 63# 64# Files can be ".c", ".S" or ".asm". ".s" files can't be used because they 65# don't get any preprocessing so there's no way to do renaming of their 66# functions. 67# 68# 69# WHOLE DIRECTORIES 70# 71# If a directory is given, then all files in it will be made available. 72# For example, 73# 74# cd $builddir/tune 75# perl $srcdir/tune/many.pl $HOME/newcode 76# 77# Each file should have a suffix, like "_experiment" above. 78# 79# 80# MPN DIRECTORIES 81# 82# mpn directories from the GMP source tree can be included, and this is a 83# convenient way to compare multiple implementations suiting different chips 84# in a CPU family. For example the following would make all x86 routines 85# available, 86# 87# cd $builddir/tune 88# perl $srcdir/tune/many.pl `find $srcdir/mpn/x86 -type d` 89# 90# On a new x86 chip a comparison could then be made to see how existing code 91# runs. For example, 92# 93# make -f Makefile.many speed-many 94# ./speed-many -s 1-30 -c \ 95# mpn_add_n_x86 mpn_add_n_pentium mpn_add_n_k6 mpn_add_n_k7 96# 97# Files in "mpn" subdirectories don't need the "_experiment" style suffix 98# described above, instead a suffix is constructed from the subdirectory. 99# For example "mpn/x86/k7/mmx/mod_1.asm" will generate a function 100# mpn_mod_1_k7_mmx. The rule is to take the last directory name after the 101# "mpn", or the last two if there's three or more. (Check the generated 102# speed-many.c if in doubt.) 103# 104# 105# GENERIC C 106# 107# The mpn/generic directory can be included too, just like any processor 108# specific directory. This is a good way to compare assembler and generic C 109# implementations. For example, 110# 111# cd $builddir/tune 112# perl $srcdir/tune/many.pl $srcdir/mpn/generic 113# 114# or if just a few routines are of interest, then for example 115# 116# cd $builddir/tune 117# perl $srcdir/tune/many.pl \ 118# $srcdir/mpn/generic/lshift.c \ 119# $srcdir/mpn/generic/mod_1.c \ 120# $srcdir/mpn/generic/aorsmul_1.c 121# 122# giving mpn_lshift_generic etc. 123# 124# 125# TESTS/DEVEL PROGRAMS 126# 127# Makefile.many also has rules to build the tests/devel programs with suitable 128# renaming, and with some parameters for correctness or speed. This is less 129# convenient than the speed and try programs, but provides an independent 130# check. For example, 131# 132# make -f Makefile.many tests_mul_1_experimental 133# ./tests_mul_1_experimental 134# 135# and for speed 136# 137# make -f Makefile.many tests_mul_1_experimental_sp 138# ./tests_mul_1_experimental_sp 139# 140# Not all the programs support speed measuring, in which case only the 141# correctness test will be useful. 142# 143# The parameters for repetitions and host clock speed are -D defines. Some 144# defaults are provided at the end of Makefile.many, but probably these will 145# want to be overridden. For example, 146# 147# rm tests_mul_1_experimental.o 148# make -f Makefile.many \ 149# CFLAGS_TESTS="-DSIZE=50 -DTIMES=1000 -DRANDOM -DCLOCK=175000000" \ 150# tests_mul_1_experimental 151# ./tests_mul_1_experimental 152# 153# 154# OTHER NOTES 155# 156# The mappings of file names to functions, and the macros to then use for 157# speed measuring etc are driven by @table below. The scheme isn't 158# completely general, it's only got as many variations as have been needed 159# so far. 160# 161# Some functions are only made available in speed-many, or others only in 162# try-many. An @table entry speed=>none means no speed measuring is 163# available, or try=>none no try program testing. These can be removed 164# if/when the respective programs get the necessary support. 165# 166# If a file has "1c" or "nc" carry-in entrypoints, they're renamed and made 167# available too. These are recognised from PROLOGUE or MULFUNC_PROLOGUE in 168# .S and .asm files, or from a line starting with "mpn_foo_1c" in a .c file 169# (possibly via a #define), and on that basis are entirely optional. This 170# entrypoint matching is done for the standard entrypoints too, but it would 171# be very unusual to have for instance a mul_1c without a mul_1. 172# 173# Some mpz files are recognized. For example an experimental copy of 174# mpz/powm.c could be included as powm_new.c and would be called 175# mpz_powm_new. So far only speed measuring is available for these. 176# 177# For the ".S" and ".asm" files, both PIC and non-PIC objects are built. 178# The PIC functions have a "_pic" suffix, for example "mpn_mod_1_k7_mmx_pic". 179# This can be ignored for routines that don't differ for PIC, or for CPUs 180# where everything is PIC anyway. 181# 182# K&R compilers are supported via the same ansi2knr mechanism used by 183# automake, though it's hard to believe anyone will have much interest in 184# measuring a compiler so old that it doesn't even have an ANSI mode. 185# 186# The "-t" option can be used to print a trace of the files found and what's 187# done with them. A great deal of obscure output is produced, but it can 188# indicate where or why some files aren't being recognised etc. For 189# example, 190# 191# cd $builddir/tune 192# perl $srcdir/tune/many.pl -t $HOME/newcode/add_n_weird.asm 193# 194# In general, when including new code, all that's really necessary is that 195# it will compile or assemble under the current configuration. It's fine if 196# some code doesn't actually run due to bugs, or to needing a newer CPU or 197# whatever, simply don't ask for the offending routines when invoking 198# speed-many or try-many, or don't try to run them on sizes they don't yet 199# support, or whatever. 200# 201# 202# CPU SPECIFICS 203# 204# x86 - All the x86 code will assemble on any system, but code for newer 205# chips might not run on older chips. Expect SIGILLs from new 206# instructions on old chips. 207# 208# A few "new" instructions, like cmov for instance, are done as macros 209# and will generate some equivalent plain i386 code when HAVE_HOST_CPU 210# in config.m4 indicates an old CPU. It won't run fast, but it does 211# make it possible to test correctness. 212# 213# 214# INTERNALS 215# 216# The nonsense involving $ENV is some hooks used during development to add 217# additional functions temporarily. 218# 219# 220# FUTURE 221# 222# Maybe the C files should be compiled pic and non-pic too. Wait until 223# there's a difference that might be of interest. 224# 225# Warn if a file provides no functions. 226# 227# Allow mpz and mpn files of the same name. Currently the mpn fib2_ui 228# matching hides the mpz version of that. Will need to check the file 229# contents to see which it is. Would be worth allowing an "mpz_" or "mpn_" 230# prefix on the filenames to have working versions of both in one directory. 231# 232# 233# LIMITATIONS 234# 235# Some of the command lines can become very long when a lot of files are 236# included. If this is a problem on a given system the only suggestion is 237# to run many.pl for just those that are actually wanted at a particular 238# time. 239# 240# DOS 8.3 or SysV 14 char filesystems won't work, since the long filenames 241# generated will almost certainly fail to be unique. 242 243 244use strict; 245use File::Basename; 246use Getopt::Std; 247 248my %opt; 249getopts('t', \%opt); 250 251my @DIRECTORIES = @ARGV; 252if (defined $ENV{directories}) { push @DIRECTORIES, @{$ENV{directories}} } 253 254 255# regexp - matched against the start of the filename. If a grouping "(...)" 256# is present then only the first such part is used. 257# 258# mulfunc - filenames to be generated from a multi-function file. 259# 260# funs - functions provided by the file, defaulting to the filename with mpn 261# (or mpX). 262# 263# mpX - prefix like "mpz", defaulting to "mpn". 264# 265# ret - return value type. 266# 267# args, args_<fun> - arguments for the given function. If an args_<fun> is 268# set then it's used, otherwise plain args is used. "mp_limb_t 269# carry" is appended for carry-in variants. 270# 271# try - try.c TYPE_ to use, defaulting to TYPE_fun with the function name 272# in upper case. "C" is appended for carry-in variants. Can be 273# 'none' for no try program entry. 274# 275# speed - SPEED_ROUTINE_ to use, handled like "try". 276# 277# speed_flags - SPEED_ROUTINE_ to use, handled like "try". 278 279 280my @table = 281 ( 282 { 283 'regexp'=> 'add_n|sub_n|addlsh1_n|sublsh1_n|rsh1add_n|rsh1sub_n', 284 'ret' => 'mp_limb_t', 285 'args' => 'mp_ptr wp, mp_srcptr xp, mp_srcptr yp, mp_size_t size', 286 'speed' => 'SPEED_ROUTINE_MPN_BINARY_N', 287 'speed_flags'=> 'FLAG_R_OPTIONAL', 288 }, 289 { 290 'regexp'=> 'aors_n', 291 'mulfunc'=> ['add_n','sub_n'], 292 'ret' => 'mp_limb_t', 293 'args' => 'mp_ptr wp, mp_srcptr xp, mp_srcptr yp, mp_size_t size', 294 'speed' => 'SPEED_ROUTINE_MPN_BINARY_N', 295 'speed_flags'=> 'FLAG_R_OPTIONAL', 296 }, 297 298 { 299 'regexp'=> 'addmul_1|submul_1', 300 'ret' => 'mp_limb_t', 301 'args' => 'mp_ptr wp, mp_srcptr xp, mp_size_t size, mp_limb_t mult', 302 'speed' => 'SPEED_ROUTINE_MPN_UNARY_1', 303 'speed_flags'=> 'FLAG_R', 304 }, 305 { 306 'regexp'=> 'aorsmul_1', 307 'mulfunc'=> ['addmul_1','submul_1'], 308 'ret' => 'mp_limb_t', 309 'args' => 'mp_ptr wp, mp_srcptr xp, mp_size_t size, mp_limb_t mult', 310 'speed' => 'SPEED_ROUTINE_MPN_UNARY_1', 311 'speed_flags'=> 'FLAG_R', 312 }, 313 314 { 315 'regexp'=> 'addmul_2|submul_2', 316 'ret' => 'mp_limb_t', 317 'args' => 'mp_ptr wp, mp_srcptr xp, mp_size_t size, mp_srcptr yp', 318 'speed' => 'SPEED_ROUTINE_MPN_UNARY_2', 319 'speed_flags'=> 'FLAG_R_OPTIONAL', 320 'try-minsize' => 2, 321 }, 322 { 323 'regexp'=> 'addmul_3|submul_3', 324 'ret' => 'mp_limb_t', 325 'args' => 'mp_ptr wp, mp_srcptr xp, mp_size_t size, mp_srcptr yp', 326 'speed' => 'SPEED_ROUTINE_MPN_UNARY_3', 327 'speed_flags'=> 'FLAG_R_OPTIONAL', 328 'try-minsize' => 3, 329 }, 330 { 331 'regexp'=> 'addmul_4|submul_4', 332 'ret' => 'mp_limb_t', 333 'args' => 'mp_ptr wp, mp_srcptr xp, mp_size_t size, mp_srcptr yp', 334 'speed' => 'SPEED_ROUTINE_MPN_UNARY_4', 335 'speed_flags'=> 'FLAG_R_OPTIONAL', 336 'try-minsize' => 4, 337 }, 338 { 339 'regexp'=> 'addmul_5|submul_5', 340 'ret' => 'mp_limb_t', 341 'args' => 'mp_ptr wp, mp_srcptr xp, mp_size_t size, mp_srcptr yp', 342 'speed' => 'SPEED_ROUTINE_MPN_UNARY_5', 343 'speed_flags'=> 'FLAG_R_OPTIONAL', 344 'try-minsize' => 5, 345 }, 346 { 347 'regexp'=> 'addmul_6|submul_6', 348 'ret' => 'mp_limb_t', 349 'args' => 'mp_ptr wp, mp_srcptr xp, mp_size_t size, mp_srcptr yp', 350 'speed' => 'SPEED_ROUTINE_MPN_UNARY_6', 351 'speed_flags'=> 'FLAG_R_OPTIONAL', 352 'try-minsize' => 6, 353 }, 354 { 355 'regexp'=> 'addmul_7|submul_7', 356 'ret' => 'mp_limb_t', 357 'args' => 'mp_ptr wp, mp_srcptr xp, mp_size_t size, mp_srcptr yp', 358 'speed' => 'SPEED_ROUTINE_MPN_UNARY_7', 359 'speed_flags'=> 'FLAG_R_OPTIONAL', 360 'try-minsize' => 7, 361 }, 362 { 363 'regexp'=> 'addmul_8|submul_8', 364 'ret' => 'mp_limb_t', 365 'args' => 'mp_ptr wp, mp_srcptr xp, mp_size_t size, mp_srcptr yp', 366 'speed' => 'SPEED_ROUTINE_MPN_UNARY_8', 367 'speed_flags'=> 'FLAG_R_OPTIONAL', 368 'try-minsize' => 8, 369 }, 370 371 { 372 'regexp'=> 'add_n_sub_n', 373 'ret' => 'mp_limb_t', 374 'args' => 'mp_ptr sum, mp_ptr diff, mp_srcptr xp, mp_srcptr yp, mp_size_t size', 375 'speed_flags'=> 'FLAG_R_OPTIONAL', 376 }, 377 378 { 379 'regexp'=> 'com|copyi|copyd', 380 'ret' => 'void', 381 'args' => 'mp_ptr wp, mp_srcptr xp, mp_size_t size', 382 'speed' => 'SPEED_ROUTINE_MPN_COPY', 383 }, 384 385 { 386 'regexp'=> 'dive_1', 387 'funs' => ['divexact_1'], 388 'ret' => 'void', 389 'args' => 'mp_ptr dst, mp_srcptr src, mp_size_t size, mp_limb_t divisor', 390 'speed_flags'=> 'FLAG_R', 391 }, 392 { 393 'regexp'=> 'diveby3', 394 'funs' => ['divexact_by3c'], 395 'ret' => 'mp_limb_t', 396 'args' => 'mp_ptr dst, mp_srcptr src, mp_size_t size', 397 'carrys'=> [''], 398 'speed' => 'SPEED_ROUTINE_MPN_COPY', 399 }, 400 401 # mpn_preinv_divrem_1 is an optional extra entrypoint 402 { 403 'regexp'=> 'divrem_1', 404 'funs' => ['divrem_1', 'preinv_divrem_1'], 405 'ret' => 'mp_limb_t', 406 'args_divrem_1' => 'mp_ptr rp, mp_size_t xsize, mp_srcptr sp, mp_size_t size, mp_limb_t divisor', 407 'args_preinv_divrem_1' => 'mp_ptr rp, mp_size_t xsize, mp_srcptr sp, mp_size_t size, mp_limb_t divisor, mp_limb_t inverse, unsigned shift', 408 'speed_flags'=> 'FLAG_R', 409 'speed_suffixes' => ['f'], 410 }, 411 { 412 'regexp'=> 'pre_divrem_1', 413 'funs' => ['preinv_divrem_1'], 414 'ret' => 'mp_limb_t', 415 'args' => 'mp_ptr qp, mp_size_t qxn, mp_srcptr ap, mp_size_t asize, mp_limb_t divisor, mp_limb_t inverse, int shift', 416 'speed_flags' => 'FLAG_R', 417 }, 418 419 { 420 'regexp'=> 'divrem_2', 421 'ret' => 'mp_limb_t', 422 'args' => 'mp_ptr qp, mp_size_t qxn, mp_srcptr np, mp_size_t nsize, mp_srcptr dp', 423 'try' => 'none', 424 }, 425 426 { 427 'regexp'=> 'sb_divrem_mn', 428 'ret' => 'mp_limb_t', 429 'args' => 'mp_ptr qp, mp_ptr np, mp_size_t nsize, mp_srcptr dp, mp_size_t dsize', 430 'speed' => 'SPEED_ROUTINE_MPN_DC_DIVREM_SB', 431 'try-minsize' => 3, 432 }, 433 { 434 'regexp'=> 'tdiv_qr', 435 'ret' => 'void', 436 'args' => 'mp_ptr qp, mp_size_t qxn, mp_ptr np, mp_size_t nsize, mp_srcptr dp, mp_size_t dsize', 437 'speed' => 'none', 438 }, 439 440 { 441 'regexp'=> 'get_str', 442 'ret' => 'size_t', 443 'args' => 'unsigned char *str, int base, mp_ptr mptr, mp_size_t msize', 444 'speed_flags' => 'FLAG_R_OPTIONAL', 445 'try' => 'none', 446 }, 447 { 448 'regexp'=> 'set_str', 449 'ret' => 'mp_size_t', 450 'args' => 'mp_ptr xp, const unsigned char *str, size_t str_len, int base', 451 'speed_flags' => 'FLAG_R_OPTIONAL', 452 'try' => 'none', 453 }, 454 455 { 456 'regexp'=> 'fac_ui', 457 'mpX' => 'mpz', 458 'ret' => 'void', 459 'args' => 'mpz_ptr r, unsigned long n', 460 'speed_flags' => 'FLAG_NODATA', 461 'try' => 'none', 462 }, 463 464 { 465 'regexp'=> 'fib2_ui', 466 'ret' => 'void', 467 'args' => 'mp_ptr fp, mp_ptr f1p, unsigned long n', 468 'rename'=> ['__gmp_fib_table'], 469 'speed_flags' => 'FLAG_NODATA', 470 'try' => 'none', 471 }, 472 { 473 'regexp'=> 'fib_ui', 474 'mpX' => 'mpz', 475 'ret' => 'void', 476 'args' => 'mpz_ptr fn, unsigned long n', 477 'speed_flags' => 'FLAG_NODATA', 478 'try' => 'none', 479 }, 480 { 481 'regexp'=> 'fib2_ui', 482 'mpX' => 'mpz', 483 'ret' => 'void', 484 'args' => 'mpz_ptr fn, mpz_ptr fnsub1, unsigned long n', 485 'speed_flags' => 'FLAG_NODATA', 486 'try' => 'none', 487 }, 488 489 { 490 'regexp'=> 'lucnum_ui', 491 'mpX' => 'mpz', 492 'ret' => 'void', 493 'args' => 'mpz_ptr ln, unsigned long n', 494 'speed_flags' => 'FLAG_NODATA', 495 'try' => 'none', 496 }, 497 { 498 'regexp'=> 'lucnum2_ui', 499 'mpX' => 'mpz', 500 'ret' => 'void', 501 'args' => 'mpz_ptr ln, mpz_ptr lnsub1, unsigned long n', 502 'speed_flags' => 'FLAG_NODATA', 503 'try' => 'none', 504 }, 505 506 { 507 'regexp'=> 'gcd_1', 508 'ret' => 'mp_limb_t', 509 'args' => 'mp_ptr xp, mp_size_t xsize, mp_limb_t y', 510 'speed_flags'=> 'FLAG_R_OPTIONAL', 511 'speed_suffixes' => ['N'], 512 }, 513 { 514 'regexp'=> '(gcd)(?!(_1|ext|_finda))', 515 'ret' => 'mp_size_t', 516 'args' => 'mp_ptr gp, mp_ptr up, mp_size_t usize, mp_ptr vp, mp_size_t vsize', 517 }, 518 { 519 'regexp'=> 'gcd_finda', 520 'ret' => 'mp_limb_t', 521 'args' => 'mp_srcptr cp', 522 }, 523 524 525 { 526 'regexp'=> 'jacobi', 527 'funs' => ['jacobi', 'legendre', 'kronecker'], 528 'mpX' => 'mpz', 529 'ret' => 'int', 530 'args' => 'mpz_srcptr a, mpz_srcptr b', 531 'try-legendre' => 'TYPE_MPZ_JACOBI', 532 }, 533 { 534 'regexp'=> 'jacbase', 535 'funs' => ['jacobi_base'], 536 'ret' => 'mp_limb_t', 537 'args' => 'mp_limb_t a, mp_limb_t b, int bit1', 538 'speed' => 'SPEED_ROUTINE_MPN_JACBASE', 539 'try' => 'none', 540 }, 541 542 { 543 'regexp'=> 'logops_n', 544 'mulfunc'=> ['and_n','andn_n','nand_n','ior_n','iorn_n','nior_n','xor_n','xnor_n'], 545 'ret' => 'void', 546 'args' => 'mp_ptr wp, mp_srcptr xp, mp_srcptr yp, mp_size_t size', 547 'speed' => 'SPEED_ROUTINE_MPN_BINARY_N', 548 }, 549 550 { 551 'regexp'=> '[lr]shift', 552 'ret' => 'mp_limb_t', 553 'args' => 'mp_ptr wp, mp_srcptr xp, mp_size_t size, unsigned shift', 554 'speed' => 'SPEED_ROUTINE_MPN_UNARY_1', 555 'speed_flags'=> 'FLAG_R', 556 }, 557 558 # mpn_preinv_mod_1 is an optional extra entrypoint 559 { 560 'regexp'=> '(mod_1)(?!_rs)', 561 'funs' => ['mod_1','preinv_mod_1'], 562 'ret' => 'mp_limb_t', 563 'args_mod_1' => 'mp_srcptr xp, mp_size_t size, mp_limb_t divisor', 564 'args_preinv_mod_1'=> 'mp_srcptr xp, mp_size_t size, mp_limb_t divisor, mp_limb_t inverse', 565 'speed_flags'=> 'FLAG_R', 566 }, 567 { 568 'regexp'=> 'pre_mod_1', 569 'funs' => ['preinv_mod_1'], 570 'ret' => 'mp_limb_t', 571 'args' => 'mp_srcptr xp, mp_size_t size, mp_limb_t divisor, mp_limb_t inverse', 572 'speed_flags'=> 'FLAG_R', 573 }, 574 { 575 'regexp'=> 'mod_34lsub1', 576 'ret' => 'mp_limb_t', 577 'args' => 'mp_srcptr src, mp_size_t len', 578 }, 579 { 580 'regexp'=> 'invert_limb', 581 'ret' => 'mp_limb_t', 582 'args' => 'mp_limb_t divisor', 583 'speed_flags'=> 'FLAG_R_OPTIONAL', 584 'try' => 'none', 585 }, 586 587 { 588 # not for use with hppa reversed argument versions of mpn_umul_ppmm 589 'regexp'=> 'udiv', 590 'funs' => ['udiv_qrnnd','udiv_qrnnd_r'], 591 'ret' => 'mp_limb_t', 592 'args_udiv_qrnnd' => 'mp_limb_t *, mp_limb_t, mp_limb_t, mp_limb_t', 593 'args_udiv_qrnnd_r' => 'mp_limb_t, mp_limb_t, mp_limb_t, mp_limb_t *', 594 'speed' => 'none', 595 'try-minsize' => 2, 596 }, 597 598 { 599 'regexp'=> 'mode1o', 600 'funs' => ['modexact_1_odd'], 601 'ret' => 'mp_limb_t', 602 'args' => 'mp_srcptr src, mp_size_t size, mp_limb_t divisor', 603 'speed_flags'=> 'FLAG_R', 604 }, 605 { 606 'regexp'=> 'modlinv', 607 'funs' => ['modlimb_invert'], 608 'ret' => 'mp_limb_t', 609 'args' => 'mp_limb_t v', 610 'carrys'=> [''], 611 'try' => 'none', 612 }, 613 614 { 615 'regexp'=> 'mul_1', 616 'ret' => 'mp_limb_t', 617 'args' => 'mp_ptr wp, mp_srcptr xp, mp_size_t size, mp_limb_t mult', 618 'speed' => 'SPEED_ROUTINE_MPN_UNARY_1', 619 'speed_flags'=> 'FLAG_R', 620 }, 621 { 622 'regexp'=> 'mul_2', 623 'ret' => 'mp_limb_t', 624 'args' => 'mp_ptr wp, mp_srcptr xp, mp_size_t size, mp_srcptr mult', 625 'speed' => 'SPEED_ROUTINE_MPN_UNARY_2', 626 'speed_flags'=> 'FLAG_R', 627 }, 628 629 { 630 'regexp'=> 'mul_basecase', 631 'ret' => 'void', 632 'args' => 'mp_ptr wp, mp_srcptr xp, mp_size_t xsize, mp_srcptr yp, mp_size_t ysize', 633 'speed_flags' => 'FLAG_R_OPTIONAL | FLAG_RSIZE', 634 }, 635 { 636 'regexp'=> '(mul_n)[_.]', 637 'ret' => 'void', 638 'args' => 'mp_ptr wp, mp_srcptr xp, mp_srcptr yp, mp_size_t size', 639 'rename'=> ['kara_mul_n','kara_sqr_n','toom3_mul_n','toom3_sqr_n'], 640 }, 641 { 642 'regexp'=> 'umul', 643 'funs' => ['umul_ppmm','umul_ppmm_r'], 644 'ret' => 'mp_limb_t', 645 'args_umul_ppmm' => 'mp_limb_t *lowptr, mp_limb_t m1, mp_limb_t m2', 646 'args_umul_ppmm_r' => 'mp_limb_t m1, mp_limb_t m2, mp_limb_t *lowptr', 647 'speed' => 'none', 648 'try-minsize' => 3, 649 }, 650 651 652 { 653 'regexp'=> 'popham', 654 'mulfunc'=> ['popcount','hamdist'], 655 'ret' => 'unsigned long', 656 'args_popcount'=> 'mp_srcptr xp, mp_size_t size', 657 'args_hamdist' => 'mp_srcptr xp, mp_srcptr yp, mp_size_t size', 658 }, 659 { 660 'regexp'=> 'popcount', 661 'ret' => 'unsigned long', 662 'args' => 'mp_srcptr xp, mp_size_t size', 663 }, 664 { 665 'regexp'=> 'hamdist', 666 'ret' => 'unsigned long', 667 'args' => 'mp_srcptr xp, mp_srcptr yp, mp_size_t size', 668 # extra renaming to support sharing a data table with mpn_popcount 669 'rename'=> ['popcount'], 670 }, 671 672 { 673 'regexp'=> 'sqr_basecase', 674 'ret' => 'void', 675 'args' => 'mp_ptr wp, mp_srcptr xp, mp_size_t size', 676 'speed' => 'SPEED_ROUTINE_MPN_SQR', 677 'try' => 'TYPE_SQR', 678 }, 679 { 680 'regexp'=> 'sqr_diagonal', 681 'ret' => 'void', 682 'args' => 'mp_ptr wp, mp_srcptr xp, mp_size_t size', 683 'try' => 'none', 684 }, 685 686 { 687 'regexp'=> 'sqrtrem', 688 'ret' => 'mp_size_t', 689 'args' => 'mp_ptr root, mp_ptr rem, mp_srcptr src, mp_size_t size', 690 'try' => 'none', 691 }, 692 693 { 694 'regexp'=> 'cntlz', 695 'funs' => ['count_leading_zeros'], 696 'ret' => 'unsigned', 697 'args' => 'mp_limb_t', 698 'macro-before' => "#undef COUNT_LEADING_ZEROS_0", 699 'macro-speed' => 700'#ifdef COUNT_LEADING_ZEROS_0 701#define COUNT_LEADING_ZEROS_0_ALLOWED 1 702#else 703#define COUNT_LEADING_ZEROS_0_ALLOWED 0 704#endif 705 SPEED_ROUTINE_COUNT_ZEROS_A (1, COUNT_LEADING_ZEROS_0_ALLOWED); 706 $fun (c, n); 707 SPEED_ROUTINE_COUNT_ZEROS_B ()', 708 'speed_flags'=> 'FLAG_R_OPTIONAL', 709 'try' => 'none', 710 }, 711 { 712 'regexp'=> 'cnttz', 713 'funs' => ['count_trailing_zeros'], 714 'ret' => 'unsigned', 715 'args' => 'mp_limb_t', 716 'macro-speed' => ' 717 SPEED_ROUTINE_COUNT_ZEROS_A (0, 0); 718 $fun (c, n); 719 SPEED_ROUTINE_COUNT_ZEROS_B ()', 720 'speed_flags' => 'FLAG_R_OPTIONAL', 721 'try' => 'none', 722 }, 723 724 { 725 'regexp'=> 'zero', 726 'ret' => 'void', 727 'args' => 'mp_ptr ptr, mp_size_t size', 728 }, 729 730 { 731 'regexp'=> '(powm)(?!_ui)', 732 'mpX' => 'mpz', 733 'ret' => 'void', 734 'args' => 'mpz_ptr r, mpz_srcptr b, mpz_srcptr e, mpz_srcptr m', 735 'try' => 'none', 736 }, 737 { 738 'regexp'=> 'powm_ui', 739 'mpX' => 'mpz', 740 'ret' => 'void', 741 'args' => 'mpz_ptr r, mpz_srcptr b, unsigned long e, mpz_srcptr m', 742 'try' => 'none', 743 }, 744 745 # special for use during development 746 { 747 'regexp'=> 'back', 748 'funs' => ['back_to_back'], 749 'ret' => 'void', 750 'args' => 'void', 751 'pic' => 'no', 752 'try' => 'none', 753 'speed_flags'=> 'FLAG_NODATA', 754 }, 755 ); 756 757if (defined $ENV{table2}) { 758 my @newtable = @{$ENV{table2}}; 759 push @newtable, @table; 760 @table = @newtable; 761} 762 763 764my %pictable = 765 ( 766 'yes' => { 767 'suffix' => '_pic', 768 'asmflags'=> '$(ASMFLAGS_PIC)', 769 'cflags' => '$(CFLAGS_PIC)', 770 }, 771 'no' => { 772 'suffix' => '', 773 'asmflags'=> '', 774 'cflags' => '', 775 }, 776 ); 777 778 779my $builddir = $ENV{builddir}; 780$builddir = "." if (! defined $builddir); 781 782my $top_builddir = "${builddir}/.."; 783 784 785open(MAKEFILE, "<${builddir}/Makefile") 786 or die "Cannot open ${builddir}/Makefile: $!\n" 787 . "Is this a tune build directory?"; 788my ($srcdir, $top_srcdir); 789while (<MAKEFILE>) { 790 if (/^srcdir = (.*)/) { $srcdir = $1; } 791 if (/^top_srcdir = (.*)/) { $top_srcdir = $1; } 792} 793die "Cannot find \$srcdir in Makefile\n" if (! defined $srcdir); 794die "Cannot find \$top_srcdir in Makefile\n" if (! defined $top_srcdir); 795print "srcdir $srcdir\n" if $opt{'t'}; 796print "top_srcdir $top_srcdir\n" if $opt{'t'}; 797close(MAKEFILE); 798 799 800open(SPEED, ">speed-many.c") or die; 801print SPEED 802"/* speed-many.c generated by many.pl - DO NOT EDIT, CHANGES WILL BE LOST */ 803 804"; 805my $SPEED_EXTRA_ROUTINES = "#define SPEED_EXTRA_ROUTINES \\\n"; 806my $SPEED_EXTRA_PROTOS = "#define SPEED_EXTRA_PROTOS \\\n"; 807my $SPEED_CODE = ""; 808 809open(TRY, ">try-many.c") or die; 810print TRY 811 "/* try-many.c generated by many.pl - DO NOT EDIT, CHANGES WILL BE LOST */\n" . 812 "\n"; 813my $TRY_EXTRA_ROUTINES = "#define EXTRA_ROUTINES \\\n"; 814my $TRY_EXTRA_PROTOS = "#define EXTRA_PROTOS \\\n"; 815 816open(FD,"<${top_builddir}/libtool") or die "Cannot open \"${top_builddir}/libtool\": $!\n"; 817my $pic_flag; 818while (<FD>) { 819 if (/^pic_flag="?([^"]*)"?$/) { 820 $pic_flag=$1; 821 last; 822 } 823} 824close FD; 825if (! defined $pic_flag) { 826 die "Cannot find pic_flag in ${top_builddir}/libtool"; 827} 828 829my $CFLAGS_PIC = $pic_flag; 830 831my $ASMFLAGS_PIC = ""; 832foreach (split /[ \t]/, $pic_flag) { 833 if (/^-D/) { 834 $ASMFLAGS_PIC .= " " . $_; 835 } 836} 837 838open(MAKEFILE, ">Makefile.many") or die; 839print MAKEFILE 840 "# Makefile.many generated by many.pl - DO NOT EDIT, CHANGES WILL BE LOST\n" . 841 "\n" . 842 "all: speed-many try-many\n" . 843 "\n" . 844 "#--------- begin included copy of basic Makefile ----------\n" . 845 "\n"; 846open(FD,"<${builddir}/Makefile") or die "Cannot open \"${builddir}/Makefile\": $!\n"; 847print MAKEFILE <FD>; 848close FD; 849print MAKEFILE 850 "\n" . 851 "#--------- end included copy of basic Makefile ----------\n" . 852 "\n" . 853 "CFLAGS_PIC = $CFLAGS_PIC\n" . 854 "ASMFLAGS_PIC = $ASMFLAGS_PIC\n" . 855 "\n"; 856 857my $CLEAN=""; 858my $MANY_OBJS=""; 859 860 861sub print_ansi2knr { 862 my ($base,$file,$includes) = @_; 863 if (! defined $file) { $file = "$base.c"; } 864 if (! defined $includes) { $includes = ""; } 865 866 print MAKEFILE <<EOF; 867${base}_.c: $file \$(ANSI2KNR) 868 \$(CPP) \$(DEFS) \$(INCLUDES) $includes \$(AM_CPPFLAGS) \$(CPPFLAGS) $file | sed 's/^# \([0-9]\)/#line \\1/' | \$(ANSI2KNR) >${base}_.c 869 870EOF 871} 872 873 874# Spawning a glob is a touch slow when there's lots of files. 875my @files = (); 876foreach my $dir (@DIRECTORIES) { 877 print "dir $dir\n" if $opt{'t'}; 878 if (-f $dir) { 879 push @files,$dir; 880 } else { 881 if (! opendir DD,$dir) { 882 print "Cannot open $dir: $!\n"; 883 } else { 884 push @files, map {$_="$dir/$_"} grep /\.(c|asm|S|h)$/, readdir DD; 885 closedir DD; 886 } 887 } 888} 889@files = sort @files; 890print "@files ",join(" ",@files),"\n" if $opt{'t'}; 891 892my $count_files = 0; 893my $count_functions = 0; 894my %seen_obj; 895my %seen_file; 896 897foreach my $file_full (@files) { 898 if (! -f $file_full) { 899 print "Not a file: $file_full\n"; 900 next; 901 } 902 if (defined $seen_file{$file_full}) { 903 print "Skipping duplicate file: $file_full\n"; 904 next; 905 } 906 $seen_file{$file_full} = 1; 907 908 my ($FILE,$path,$lang) = fileparse($file_full,"\.[a-zA-Z]+"); 909 $path =~ s/\/$//; 910 print "file $FILE path $path lang $lang\n" if $opt{'t'}; 911 912 my @pic_choices; 913 if ($lang eq '.asm') { @pic_choices=('no','yes'); } 914 elsif ($lang eq '.c') { @pic_choices=('no'); } 915 elsif ($lang eq '.S') { @pic_choices=('no','yes'); } 916 elsif ($lang eq '.h') { @pic_choices=('no'); } 917 else { next }; 918 919 my ($t, $file_match); 920 foreach my $p (@table) { 921 # print " ",$p->{'regexp'},"\n" if $opt{'t'}; 922 if ($FILE =~ "^($p->{'regexp'})") { 923 $t = $p; 924 $file_match = $1; 925 $file_match = $2 if defined $2; 926 last; 927 } 928 } 929 next if ! defined $t; 930 print "match $t->{'regexp'} $FILE ($file_full)\n" if $opt{'t'}; 931 932 if (! open FD,"<$file_full") { print "Can't open $file_full: $!\n"; next } 933 my @file_contents = <FD>; 934 close FD; 935 936 my $objs; 937 if (defined $t->{'mulfunc'}) { $objs = $t->{'mulfunc'}; } 938 else { $objs = [$file_match]; } 939 print "objs @$objs\n" if $opt{'t'}; 940 941 my $ret = $t->{'ret'}; 942 if (! defined $ret && $lang eq '.h') { $ret = ''; } 943 if (! defined $ret) { die "$FILE return type not defined\n" }; 944 print "ret $ret\n" if $opt{'t'}; 945 946 my $mpX = $t->{'mpX'}; 947 if (! defined $mpX) { $mpX = ($lang eq '.h' ? '' : 'mpn'); } 948 $mpX = "${mpX}_" if $mpX ne ''; 949 print "mpX $mpX\n" if $opt{'t'}; 950 951 my $carrys; 952 if (defined $t->{'carrys'}) { $carrys = $t->{'carrys'}; } 953 else { $carrys = ['','c']; } 954 print "carrys $carrys @$carrys\n" if $opt{'t'}; 955 956 # some restriction functions are implemented, but they're not very useful 957 my $restriction=''; 958 959 my $suffix; 960 if ($FILE =~ ("${file_match}_(.+)")) { 961 $suffix = $1; 962 } elsif ($path =~ /\/mp[zn]\/(.*)$/) { 963 # derive the suffix from the path 964 $suffix = $1; 965 $suffix =~ s/\//_/g; 966 # use last directory name, or if there's 3 or more then the last two 967 if ($suffix =~ /([^_]*_)+([^_]+_[^_]+)$/) { 968 $suffix = $2; 969 } elsif ($suffix =~ /([^_]*_)*([^_]+)$/) { 970 $suffix = $2; 971 } 972 } else { 973 die "Can't determine suffix for: $file_full (path $path)\n"; 974 } 975 print "suffix $suffix\n" if $opt{'t'}; 976 977 $count_files++; 978 979 foreach my $obj (@{$objs}) { 980 print "obj $obj\n" if $opt{'t'}; 981 982 my $obj_with_suffix = "${obj}_$suffix"; 983 if (defined $seen_obj{$obj_with_suffix}) { 984 print "Skipping duplicate object: $obj_with_suffix\n"; 985 print " first from: $seen_obj{$obj_with_suffix}\n"; 986 print " now from: $file_full\n"; 987 next; 988 } 989 $seen_obj{$obj_with_suffix} = $file_full; 990 991 my $funs = $t->{'funs'}; 992 $funs = [$obj] if ! defined $funs; 993 print "funs @$funs\n" if $opt{'t'}; 994 995 if (defined $t->{'pic'}) { @pic_choices = ('no'); } 996 997 foreach my $pic (map {$pictable{$_}} @pic_choices) { 998 print "pic $pic->{'suffix'}\n" if $opt{'t'}; 999 1000 my $objbase = "${obj}_$suffix$pic->{'suffix'}"; 1001 print "objbase $objbase\n" if $opt{'t'}; 1002 1003 if ($path !~ "." && -f "${objbase}.c") { 1004 die "Already have ${objbase}.c"; 1005 } 1006 1007 my $tmp_file = "tmp-$objbase.c"; 1008 1009 my $renaming; 1010 foreach my $fun (@{$funs}) { 1011 if ($mpX eq 'mpn_' && $lang eq '.c') { 1012 $renaming .= "\t\t-DHAVE_NATIVE_mpn_$fun=1 \\\n"; 1013 } 1014 1015 # The carry-in variant is with a "c" appended, unless there's a "_1" 1016 # somewhere, eg. "modexact_1_odd", in which case that becomes "_1c". 1017 my $fun_carry = $fun; 1018 if (! ($fun_carry =~ s/_1/_1c/)) { $fun_carry = "${fun}c"; } 1019 1020 $renaming .= 1021 "\t\t-D__g$mpX$fun=$mpX${fun}_$suffix$pic->{'suffix'} \\\n" . 1022 "\t\t-D__g$mpX$fun_carry=$mpX${fun_carry}_$suffix$pic->{'suffix'} \\\n"; 1023 } 1024 foreach my $r (@{$t->{'rename'}}) { 1025 if ($r =~ /^__gmp/) { 1026 $renaming .= "\\\n" . 1027 "\t\t-D$r=${r}_$suffix$pic->{'suffix'}"; 1028 } else { 1029 $renaming .= "\\\n" . 1030 "\t\t-D__g$mpX$r=$mpX${r}_$suffix$pic->{'suffix'}"; 1031 } 1032 } 1033 print "renaming $renaming\n" if $opt{'t'}; 1034 1035 print MAKEFILE "\n"; 1036 if ($lang eq '.asm') { 1037 print MAKEFILE 1038 "$objbase.o: $file_full \$(ASM_HEADERS)\n" . 1039 " \$(M4) \$(M4FLAGS) -DOPERATION_$obj $pic->{'asmflags'} \\\n" . 1040 "$renaming" . 1041 " $file_full >tmp-$objbase.s\n" . 1042 " \$(CCAS) \$(COMPILE_FLAGS) $pic->{'cflags'} tmp-$objbase.s -o $objbase.o\n" . 1043 " \$(RM_TMP) tmp-$objbase.s\n"; 1044 $MANY_OBJS .= " $objbase.o"; 1045 1046 } elsif ($lang eq '.c') { 1047 print MAKEFILE 1048 "$objbase.o: $file_full\n" . 1049 " \$(COMPILE) -DOPERATION_$obj $pic->{'cflags'} \\\n" . 1050 "$renaming" . 1051 " -c $file_full -o $objbase.o\n"; 1052 print_ansi2knr($objbase, 1053 $file_full, 1054 " -DOPERATION_$obj\\\n$renaming\t\t"); 1055 $MANY_OBJS .= " $objbase\$U.o"; 1056 1057 } elsif ($lang eq '.S') { 1058 print MAKEFILE 1059 "$objbase.o: $file_full\n" . 1060 " \$(COMPILE) -g $pic->{'asmflags'} \\\n" . 1061 "$renaming" . 1062 " -c $file_full -o $objbase.o\n"; 1063 $MANY_OBJS .= " $objbase.o"; 1064 1065 } elsif ($lang eq '.h') { 1066 print MAKEFILE 1067 "$objbase.o: tmp-$objbase.c $file_full\n" . 1068 " \$(COMPILE) -DOPERATION_$obj $pic->{'cflags'} \\\n" . 1069 "$renaming" . 1070 " -c tmp-$objbase.c -o $objbase.o\n"; 1071 print_ansi2knr($objbase, 1072 "tmp-$objbase.c", 1073 " -DOPERATION_$obj\\\n$renaming\t\t"); 1074 $MANY_OBJS .= " $objbase\$U.o"; 1075 1076 $CLEAN .= " tmp-$objbase.c"; 1077 open(TMP_C,">tmp-$objbase.c") 1078 or die "Can't create tmp-$objbase.c: $!\n"; 1079 print TMP_C 1080"/* tmp-$objbase.c generated by many.pl - DO NOT EDIT, CHANGES WILL BE LOST */ 1081 1082#include \"gmp.h\" 1083#include \"gmp-impl.h\" 1084#include \"longlong.h\" 1085#include \"speed.h\" 1086 1087"; 1088 } 1089 1090 my $tests_program = "$top_srcdir/tests/devel/$obj.c"; 1091 if (-f $tests_program) { 1092 $tests_program = "\$(top_srcdir)/tests/devel/$obj.c"; 1093 print_ansi2knr("tests_${objbase}", 1094 $tests_program, 1095 "\\\n$renaming\t\t\$(CFLAGS_TESTS_SP)"); 1096 print_ansi2knr("tests_${objbase}_sp", 1097 $tests_program, 1098 "\\\n$renaming\t\t\$(CFLAGS_TESTS_SP)"); 1099 1100 print MAKEFILE <<EOF; 1101tests_$objbase.o: $tests_program 1102 \$(COMPILE) \$(CFLAGS_TESTS) \\ 1103$renaming -c $tests_program -o tests_$objbase.o 1104 1105tests_$objbase: $objbase\$U.o tests_$objbase\$U.o ../libgmp.la 1106 \$(LINK) tests_$objbase\$U.o $objbase\$U.o ../libgmp.la -o tests_$objbase 1107 1108tests_${objbase}_sp.o: $tests_program 1109 \$(COMPILE) \$(CFLAGS_TESTS_SP) \\ 1110$renaming -c $tests_program -o tests_${objbase}_sp.o 1111 1112tests_${objbase}_sp: $objbase\$U.o tests_${objbase}_sp\$U.o ../libgmp.la 1113 \$(LINK) tests_${objbase}_sp\$U.o $objbase\$U.o ../libgmp.la -o tests_${objbase}_sp 1114 1115EOF 1116 $CLEAN .= " tests_$objbase tests_${objbase}_sp"; 1117 } 1118 1119 foreach my $fun (@{$funs}) { 1120 print "fun $fun\n" if $opt{'t'}; 1121 1122 if ($lang eq '.h') { 1123 my $macro_before = $t->{'macro_before'}; 1124 $macro_before = "" if ! defined $macro_before; 1125 print TMP_C 1126"$macro_before 1127#undef $fun 1128#include \"$file_full\" 1129 1130"; 1131 } 1132 1133 my $args = $t->{"args_$fun"}; 1134 if (! defined $args) { $args = $t->{'args'}; } 1135 if (! defined $args) { die "Need args for $fun\n"; } 1136 print "args $args\n" if $opt{'t'}; 1137 1138 foreach my $carry (@$carrys) { 1139 print "carry $carry\n" if $opt{'t'}; 1140 1141 my $fun_carry = $fun; 1142 if (! ($fun_carry =~ s/_1/_1$carry/)) { $fun_carry = "$fun$carry"; } 1143 print "fun_carry $fun_carry\n" if $opt{'t'}; 1144 1145 if ($lang =~ /\.(asm|S)/ 1146 && ! grep(m"PROLOGUE\((.* )?$mpX$fun_carry[ ,)]",@file_contents)) { 1147 print "no PROLOGUE $mpX$fun_carry\n" if $opt{'t'}; 1148 next; 1149 } 1150 if ($lang eq '.c' 1151 && ! grep(m"^(#define FUNCTION\s+)?$mpX$fun_carry\W", @file_contents)) { 1152 print "no mention of $mpX$fun_carry\n" if $opt{'t'}; 1153 next; 1154 } 1155 if ($lang eq '.h' 1156 && ! grep(m"^#define $fun_carry\W", @file_contents)) { 1157 print "no mention of #define $fun_carry\n" if $opt{'t'}; 1158 next; 1159 } 1160 1161 $count_functions++; 1162 1163 my $carryarg; 1164 if (defined $t->{'carryarg'}) { $carryarg = $t->{'carryarg'}; } 1165 if ($carry eq '') { $carryarg = ''; } 1166 else { $carryarg = ', mp_limb_t carry'; } 1167 print "carryarg $carryarg\n" if $opt{'t'}; 1168 1169 my $funfull="$mpX${fun_carry}_$suffix$pic->{'suffix'}"; 1170 print "funfull $funfull\n" if $opt{'t'}; 1171 1172 if ($lang ne '.h') { 1173 my $proto = "$t->{'ret'} $funfull _PROTO (($args$carryarg)); \\\n"; 1174 $SPEED_EXTRA_PROTOS .= $proto; 1175 $TRY_EXTRA_PROTOS .= $proto; 1176 } 1177 1178 my $try_type = $t->{"try-$fun"}; 1179 $try_type = $t->{'try'} if ! defined $try_type; 1180 if (! defined $try_type) { 1181 if ($mpX eq 'mpn_') { 1182 $try_type = "TYPE_\U$fun_carry"; 1183 } else { 1184 $try_type = "TYPE_\U$mpX\U$fun_carry"; 1185 } 1186 } 1187 print "try_type $try_type\n" if $opt{'t'}; 1188 1189 my $try_minsize = $t->{'try-minsize'}; 1190 if (defined $try_minsize) { 1191 $try_minsize = ", " . $try_minsize; 1192 } else { 1193 $try_minsize = ""; 1194 } 1195 print "try_minsize $try_minsize\n" if $opt{'t'}; 1196 1197 if ($try_type ne 'none') { 1198 $TRY_EXTRA_ROUTINES .= 1199 " { TRY($mpX${fun_carry}_$suffix$pic->{'suffix'}), $try_type$try_minsize }, \\\n"; 1200 } 1201 1202 my $speed_flags = $t->{'speed_flags'}; 1203 $speed_flags = '0' if ! defined $speed_flags; 1204 print "speed_flags $speed_flags\n" if $opt{'t'}; 1205 1206 my $speed_routine = $t->{'speed'}; 1207 $speed_routine = "SPEED_ROUTINE_\U$mpX\U$fun" 1208 if !defined $speed_routine; 1209 if (! ($speed_routine =~ s/_1/_1\U$carry/)) { 1210 $speed_routine = "$speed_routine\U$carry"; 1211 } 1212 print "speed_routine $speed_routine\n" if $opt{'t'}; 1213 1214 my @speed_suffixes = (); 1215 push (@speed_suffixes, '') if $speed_routine ne 'none'; 1216 push (@speed_suffixes, @{$t->{'speed_suffixes'}}) 1217 if defined $t->{'speed_suffixes'}; 1218 1219 my $macro_speed = $t->{'macro-speed'}; 1220 $macro_speed = "$speed_routine ($fun_carry)" if ! defined $macro_speed; 1221 $macro_speed =~ s/\$fun/$fun_carry/g; 1222 1223 foreach my $S (@speed_suffixes) { 1224 my $Sfunfull="$mpX${fun_carry}${S}_$suffix$pic->{'suffix'}"; 1225 1226 $SPEED_EXTRA_PROTOS .= 1227 "double speed_$Sfunfull _PROTO ((struct speed_params *s)); \\\n"; 1228 $SPEED_EXTRA_ROUTINES .= 1229 " { \"$Sfunfull\", speed_$Sfunfull, $speed_flags }, \\\n"; 1230 if ($lang eq '.h') { 1231 print TMP_C 1232"double 1233speed_$Sfunfull (struct speed_params *s) 1234{ 1235$macro_speed 1236} 1237 1238"; 1239 } else { 1240 $SPEED_CODE .= 1241 "double\n" . 1242 "speed_$Sfunfull (struct speed_params *s)\n" . 1243 "{\n" . 1244 "$restriction" . 1245 " $speed_routine\U$S\E ($funfull)\n" . 1246 "}\n"; 1247 } 1248 } 1249 } 1250 } 1251 } 1252 } 1253} 1254 1255 1256print SPEED $SPEED_EXTRA_PROTOS . "\n"; 1257print SPEED $SPEED_EXTRA_ROUTINES . "\n"; 1258if (defined $ENV{speedinc}) { print SPEED $ENV{speedinc} . "\n"; } 1259print SPEED 1260 "#include \"speed.c\"\n" . 1261 "\n"; 1262print SPEED $SPEED_CODE; 1263 1264print TRY $TRY_EXTRA_ROUTINES . "\n"; 1265print TRY $TRY_EXTRA_PROTOS . "\n"; 1266my $tryinc = ""; 1267if (defined $ENV{tryinc}) { 1268 $tryinc = $ENV{tryinc}; 1269 print TRY "#include \"$tryinc\"\n"; 1270} 1271print "tryinc $tryinc\n" if $opt{'t'}; 1272print TRY 1273 "#include \"try.c\"\n" . 1274 "\n"; 1275 1276my $extra_libraries = ""; 1277if (defined $ENV{extra_libraries}) { $extra_libraries = $ENV{extra_libraries};} 1278 1279my $trydeps = ""; 1280if (defined $ENV{trydeps}) { $trydeps = $ENV{trydeps}; } 1281$trydeps .= " $tryinc"; 1282print "trydeps $trydeps\n" if $opt{'t'}; 1283 1284print MAKEFILE <<EOF; 1285 1286MANY_OBJS = $MANY_OBJS 1287MANY_CLEAN = \$(MANY_OBJS) \\ 1288 speed-many.c speed-many\$U.o speed-many\$(EXEEXT) \\ 1289 try-many.c try-many\$U.o try-many \\ 1290 $CLEAN 1291MANY_DISTCLEAN = Makefile.many 1292 1293speed-many: \$(MANY_OBJS) speed-many\$U.o libspeed.la $extra_libraries 1294 \$(LINK) \$(LDFLAGS) speed-many\$U.o \$(MANY_OBJS) \$(LDADD) \$(LIBS) $extra_libraries 1295 1296try-many: \$(MANY_OBJS) try-many\$U.o libspeed.la $extra_libraries 1297 \$(LINK) \$(LDFLAGS) try-many\$U.o \$(MANY_OBJS) \$(LDADD) \$(LIBS) $extra_libraries 1298 1299try-many.o: try-many.c \$(top_srcdir)/tests/devel/try.c $trydeps 1300 \$(COMPILE) -I\$(top_srcdir)/tests/devel -c try-many.c 1301 1302EOF 1303 1304print_ansi2knr("speed-many"); 1305print_ansi2knr("try-many", 1306 "\$(top_srcdir)/tests/devel/try.c", 1307 "-I\$(top_srcdir)/tests/devel"); 1308 1309print MAKEFILE <<EOF; 1310RM_TMP = rm -f 1311CFLAGS_TESTS = -DSIZE=50 -DTIMES=1 -DRANDOM -DCLOCK=333000000 1312CFLAGS_TESTS_SP = -DSIZE=1024 -DNOCHECK -DOPS=200000000 -DCLOCK=333000000 1313EOF 1314 1315close MAKEFILE or die; 1316 1317print "Total $count_files files, $count_functions functions\n"; 1318 1319 1320 1321# Local variables: 1322# perl-indent-level: 2 1323# End: 1324