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