#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of shell archive."
# Contents:  CHANGES IN README Samples src src/Makefile src/lip.c
#   src/lip.h src/mpqs.c src/sparc-solaris.s src/sparc-sunos.s
# Wrapped by warlord@toxicwaste on Wed Oct 27 16:21:29 1993
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'CHANGES' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'CHANGES'\"
else
echo shar: Extracting \"'CHANGES'\" \(215 characters\)
sed "s/^X//" >'CHANGES' <<'END_OF_FILE'
XChanges in MPQS version 1.5
X
XFixes for i386/486 machines, where the old mpqs would die with a
XFPE after some time.
X
XAdded a number of new machines to the makefile.
X
XAdded some host-specific speedups to the Makefile
END_OF_FILE
if test 215 -ne `wc -c <'CHANGES'`; then
    echo shar: \"'CHANGES'\" unpacked with wrong size!
fi
# end of 'CHANGES'
fi
if test -f 'IN' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'IN'\"
else
echo shar: Extracting \"'IN'\" \(229 characters\)
sed "s/^X//" >'IN' <<'END_OF_FILE'
X2 1 i
X114381625757888867669235779976146612010218296721242362562561842935706\
X935245733897830597123563958705058989075147599290026879543541
X5 524338 163336000 108 1073741824
X10174969370491404933477808051
X1
Xfactor@hot-spare.mit.edu
END_OF_FILE
if test 229 -ne `wc -c <'IN'`; then
    echo shar: \"'IN'\" unpacked with wrong size!
fi
# end of 'IN'
fi
if test -f 'README' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'README'\"
else
echo shar: Extracting \"'README'\" \(9111 characters\)
sed "s/^X//" >'README' <<'END_OF_FILE'
X			RSA-129 Information
X			   Derek Atkins
X			 <warlord@MIT.EDU>
X			    26 Oct 1993
X
XVersion: $Id: README,v 1.5 1993/10/26 21:54:57 warlord Exp $
X
X	INTRODUCTION
X	------------
X
X	This document describes how to get started on the RSA-129
Xproject using MPQS, the Multiple Polynomial Quadratic Sieve.  This
Xdescribes how to build the software and set up your machines to start
Xrunning the sieve and sending results back to the central location.
XThis document assumes that you understand what we are doing and why,
Xand where the prize money will go if we win it.
X
X	If you are reading this, then you have successfully obtained a
Xcopy of the mpqs sources.  Included in this distribution you should
Xsee the following files: IN, Makefile, lip.c, lip.h, mpqs.c,
Xsparc-solaris.s, and sparc-sunos.s.
X
X	GETTING STARTED
X	---------------
X
X	First thing to do is to compile the siever, called mpqs.
XCurrently this software builds on a number of UNIX platforms, and each
Xhas a make rule to go with the machine type:
X
X	Make Rule	Machine
X	---------	-------
X	DS_mpqs		DECstations (ultrix)
X	S4a_mpqs	Sun4 (SunOS4)
X	S4S_mpqs	Sun4 (Solaris)
X	VS_mpqs		VAXstation (bsd43)
X	alpha_mpqs	DEC alpha (osf/1)
X	HP_mpqs		HP/UX (requires unbundled compiler)
X	HP_gcc_mpqs	HP/UX with gcc compiler
X	rs6000_mpqs	RS/6000 (AIX)
X	SGI1_mpqs	r2000/r3000 CPU
X	SGI2_mpqs	r4000 CPU
X	linux_mpqs	i86/Linux
X	Gen_mpqs	(A good starting point)
X
X	You should now have a file called "mpqs" in the current build
Xdirectory.  This should be moved to some place where all the worker
Xmachines can get to it, such as an NFS or AFS volume, or copy it to
Xeach machine.  If this destination is a shared directory, you can set
Xthe INSTALLDIR variable in the makefile and then "make install" to
Xcopy the program.
X
X	All worker machines need to have access to the file "RESTART".
XThis will get created the first time you run mpqs, and each subsequent
Xrun can use this file.  The RESTART file will be just short of 5 Meg,
Xso be prepared for this to be created.  (See the section on creating
Xthe RESTART file for more information).  Each worker machine can use
Xthe same RESTART file.  If this is on a NFS or AFS filesystem, each
Xworker need not generate this file, which saves a lot of time and disk
Xspace.
X
X	Enclosed in this package is a file called "IN". This is what
Xyou need to feed to a worker to start sieving.  On the first line of
Xthis file there is a letter `i', which needs to be replaced with the
XUID you have assigned to this particular mpqs process.  UIDs are
Xdescribed in more detail later in this document.  For example, if you
Xare running on 100 machines and have the UID range of 1000-1099, then
Xstart the first worker at 1000.  An example of the "IN" file for this
Xworker is:
X
X2 1 1000      <- this is the UID assigned
X114381625757888867669235779976146612010218296721242362562561842935706\
X935245733897830597123563958705058989075147599290026879543541
X5 524338 163336000 108 1073741824
X10174969370491404933477808051
X1
Xfactor@hot-spare.mit.edu
X
X	The last line, "factor@hot-spare.mit.edu" is the mailing
Xaddress where factorization data is sent.  Only data created by the
Xmpqs process should be sent to this address.  Also, this address
Xshould not be changed without consulting the leaders of the RSA-129
Xproject.
X
X	Note: It is possible, if you cannot send mail directly, to
Xcollect mail on this siever and then send it in at a later date.  If
Xyou change the "1" in the second-to-last line to a "0", it will cause
Xmpqs to not attempt to send in relations via mail.  Rather, mpqs will
Xsave the relations to a file, which you must mail in by hand at a
Xlater date.
X
X	A good way to do this is to copy the IN file into /usr/tmp on
Xeach machine you set up as an mpqs client, and on each machine edit
Xthe file in /usr/tmp to reflect the UID of that particular run.  If
Xyou have RESTART and the mpqs program in some distributed file system,
Xthis works well.  As an example, what I do is copy the IN file to
X/usr/tmp, edit the file in /usr/tmp to reflect the UID of the process,
Xand then run the mpqs process (more on running the process later).
X
X	RUNNING MPQS
X	------------
X
X	To run mpqs, the easiest way is to cd into some temporary
Xdirectory, like /usr/tmp, and then run the program:
X
X   mpqs /path/to/RESTART < /path/to/IN > log.mpqs
X
X	The first argument to mpqs is the path to the RESTART file.
X(This does NOT need to be an explicit path; it can be a path from the
Xcurrent directory.) Then you pipe the IN file into stdin of the
Xprogram, and shove the output into a log file, called "log.mpqs".  It
Xis possible to have any of these files in the current working
Xdirectory.  Also, the current working directory is where mpqs will
Xplace its temporary output files to collect the relation data before
Xsending it via mail to the collecting site.
X
X	The mpqs process wants to grab as much CPU time as possible.
XTherefore, you might want to "nice" the process to allow other
Xprograms to run.  In so doing, you do not really reduce the amount of
Xcomputation being done, but you allow others to use the system in some
Xmanner.  You can nice the process at startup by running this command
Xinstead of the one given above:
X
X   nice +19 mpqs /path/to/RESTART < /path/to/IN > log.mpqs
X
X	If the RESTART file you give is either non-existant or empty,
Xmpqs will first create the RESTART file, store it in the designated
Xfile, and then continue processing.
X
X	GENERATING RESTART
X	------------------
X
X	Generating RESTART is fairly simple and follows the similar
Xlines to just starting mpqs.  Actually, the first time you run mpqs,
Xit will automatically generate the RESTART file for you.  So, to
Xgenerate the RESTART file, first cd into a temporary directory, and
Xthen run mpqs as above.
X
X	After the RESTART file is created, the mpqs process will
Xcontinue to run as if it had found a RESTART file.
X
X	OBTAINING UIDS
X	--------------
X
X	Before you can start processing data for the RSA-129 project,
Xyou need to obtain a set of UIDs to use.  *EACH* mpqs process needs to
Xrun with a different UID.  If an mpqs process gets killed for some
Xreason and you want to restart it, you should give it a new UID
Xnumber, or it will spend all its starting time recreating the data
Xthat had been created on the last run of the program.
X
X	There is a mail server set up to process your UID requests.
XTo request a UID, send mail to "factorid@hot-spare.mit.edu".  In the
Xmessage to factorid, put the following two lines in the body of the
Xmessage:
X
Xpath# your-email-address
Xid# number-of-ids-you-want
X
X	Note: The strings "path#" and "id#" are *required* to be
Xthere, as the response software keys off those phrases.
X
X	When you send this, it should respond with that appropriate
Xnumber of UIDs which you can now be sure are unique to the RSA-129
Xproject.  This assures that no one will duplicate any efforts.
X
X
X	MAILING LISTS
X	-------------
X
X	There is a mailing list for all the RSA129 workers.  If you
Xwant to be on this list, please send mail to:
X	rsa129-request@iastate.edu 
X and ask to be put on the worker list.  This list receives notices
Xabout software updates, and statistics about the progress of the
Xproject.  All workers are highly recommended to be on this list, and
Xnon workers can also be added at their request.
X
X	NOTES
X	-----
X
X	Be sure to use a different UID *every time* you start mpqs.
XIf you allow a machine to factor for a while, then restart it using
Xthe same UID, it will generate the same output.  If you use a
Xdifferent UID, then overlap is minimized and more useful data will be
Xreturned.  
X
X	This UID is an MPQS Universal IDentifier, and has no relation
Xto UNIX UID or any other IDs you may think of.  The mpqs process may
Xbe run as any user on each machine, but the UID for the mpqs process,
Xwhich you obtain from factorid@hot-spare.mit.edu, must be unique!  In
Xactuality, the MPQS UID is a seed into a random number generator.  If
Xtwo mpqs processes are running with the same UID, then they will
Xgenerate the same random numbers, and hence both processes will cover
Xthe same space.  We do not want this to happen, which is why we say
Xthat each mpqs process should have its own UID.
X
X	The mpqs process, as it is built my this Makefile, will take
Xapproximately 12 Meg of core space.  If it needs to swap at all, it
Xwill really hose the machine.  You can reduce the core size by
Xreducing the MAXSIEVE value from 3000000 to some value no lower than
X100000.  This should reduce it to about 8-9 Meg of core space.  If
Xthis is still not small enough for your memory, you might also want to
Xbuild the program "-DNO_SQRTKN".  This will cause mpqs to NOT keep a
Xcopy of the RESTART file in core, which has two effects.  First, it
Xwill reduce the amount of core by about 2 more Meg.  Second, it will
Xcause mpqs to reread the file from disk, which requires it to
Xbe present all the time!  These tradeoffs are not recommended unless
Xabsolutely necessary.  Send mail to the RSA-129 Project Administrators
Xfor help with this.
X
X	Any questions, please mail to rsa129-info@iastate.edu, and it
Xwill be answered as quickly as possible.
X
X	Thank you for joining the RSA-129 project.
X
X-RSA129 Project Coordinators
END_OF_FILE
if test 9111 -ne `wc -c <'README'`; then
    echo shar: \"'README'\" unpacked with wrong size!
fi
# end of 'README'
fi
if test -f 'Samples' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'Samples'\"
else
echo shar: Extracting \"'Samples'\" \(3585 characters\)
sed "s/^X//" >'Samples' <<'END_OF_FILE'
XFollowing is a sample run of UID 130.  These are actual results, so
Xyou can verify any ports you make by verifying against these results.
XFirst is the data that would be in the log file from mpqs (usually
Xstdout).  Following that are the first relations output from UID 130.
XThis is only for the first 10 sieves.
X
XAttempt to read restart file RESTART after       0.04 seconds at Sun Oct 24 16:4
X8:05 1993
Xsuccessful restart from file RESTART after      37.89 seconds at Sun Oct 24 16:4
X9:33 1993
Xmultiplier: 5
Xsizefacbase: 524338
Xsievelength: 163336000
Xsievebound: 108
Xmaxbig: 1073741824
Xstartd:10174969370491405073064245171
XS10; P2(125,124); p7(119,114.29,109); B473(134,110.01,106); L14.22;10174969370491405073064247471 after   13427.11 seconds at Sun Oct 24 21:54:02 1993
X  prime 70; ecm 7(+7); mis 0; bigfac 9; large 394
X
Xppr 1 from 130
Xppr1#171984221 244773349 27 1 1 1 3 2 1 4 1 175
Xppr1c# 1 257 1 1198 1 2024 1 3645 1 26429
Xppr1c# 1 33897 1 77717 1 101105 1 190072
Xppr1c# 0 40676967180848742785652381842310497272181457068210272\
Xppr1c#087803661439147827283620541352417008157837350114\
Xppr1c#1785820854969912413887180913
Xpar 1 from 130
Xpar1#1 696290509 35 -1 2 1 2 2 1 4 1 8
Xpar1c# 1 13 1 25 1 26 1 27 1 65
Xpar1c# 1 285 1 2012 1 3918 1 24312 1 114332
Xpar1c# 1 129016 1 333140 1 374776
Xpar1c# 0 7479146073617177160529943980251191483935903471876003\
Xpar1c#037873955297019423378651534357356591848675047358\
Xpar1c#2750830982384272993605929124
Xppr 2 from 130
Xppr1#68403739 70576361 25 -1 4 1 2 2 1 79 1 201
Xppr1c# 1 439 1 4236 1 8338 1 19726 1 134234
Xppr1c# 1 166249 1 226040 1 231620
Xppr1c# 0 56088418821959248450516014255319651318032041397921308\
Xppr1c#515031149591615622690180106746365957285893000161\
Xppr1c#4965724612934226136417703198
Xppr 3 from 130
Xppr1#31718513 694061917 31 -1 1 1 1 2 1 3 1 9
Xppr1c# 1 13 1 39 1 440 1 498 1 737
Xppr1c# 1 1567 1 11566 1 57443 1 152985 1 189766
Xppr1c# 1 221094
Xppr1c# 0 56088418821959248450516014255319651318032041397921308\
Xppr1c#515031149591615622690180106746365957285797205233\
Xppr1c#2886458778461035287425118675
Xppr 4 from 130
Xppr1#51290297 333044653 31 -1 3 1 2 2 1 3 1 5
Xppr1c# 1 6 1 10 1 46 1 225 1 230
Xppr1c# 1 4596 1 44251 1 49915 1 311081 1 439777
Xppr1c# 1 459028
Xppr1c# 0 1102394056985185384101875732753654687077106962699872\
Xppr1c#766249771876237844932686842168932604496311793881\
Xppr1c#4958460155725929707972733955
Xppr 5 from 130
Xppr1#22564877 147033353 29 -1 1 1 4 2 1 7 1 17
Xppr1c# 1 94 1 186 1 1022 1 1131 1 2615
Xppr1c# 1 30319 1 48689 1 58509 1 94008 1 108259
Xppr1c# 0 46459389821793896967362737692934971427619867852483724\
Xppr1c#373218519109554720747422695568350170391297104468\
Xppr1c#3902616717576166406884106808
Xppr 6 from 130
Xppr1#133496329 419327893 27 1 1 1 1 2 1 15 1 16
Xppr1c# 1 26 1 65 1 8410 1 10232 1 91095
Xppr1c# 1 97895 1 262207 1 302672 1 360448
Xppr1c# 0 47989328937538823378148561588823217629337883824914929\
Xppr1c#784064244778047444801087566311036530282378531978\
Xppr1c#4289061418986375226838150682
Xpar 2 from 130
Xpar1#1 149133301 31 1 4 1 1 2 1 4 1 7
Xpar1c# 2 8 1 155 1 1975 1 2404 1 2961
Xpar1c# 1 4358 1 59644 1 69242 1 290463 1 337887
Xpar1c# 1 341473
Xpar1c# 0 33157602351914015183860106112680308026219897308700577\
Xpar1c#797185871341434392456498914439947549890835570535\
Xpar1c#9187015808512644903949352669
Xppr 7 from 130
Xppr1#514138699 641182079 29 -1 4 1 1 2 1 4 1 5
Xppr1c# 1 102 1 462 1 1129 1 1686 1 2221
Xppr1c# 1 4870 1 8621 1 9159 1 129606 1 341955
Xppr1c# 0 51456017779881441022193625337083484026070857480891147\
Xppr1c#948559566804797944131241406933212734429426291761\
Xppr1c#9447690192681711045204490318
END_OF_FILE
if test 3585 -ne `wc -c <'Samples'`; then
    echo shar: \"'Samples'\" unpacked with wrong size!
fi
# end of 'Samples'
fi
if test ! -d 'src' ; then
    echo shar: Creating directory \"'src'\"
    mkdir 'src'
fi
if test -f 'src/Makefile' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'src/Makefile'\"
else
echo shar: Extracting \"'src/Makefile'\" \(5710 characters\)
sed "s/^X//" >'src/Makefile' <<'END_OF_FILE'
X#
X# Makefile for MPQS.  This file contains the Make Rules for a number
X# of different platforms.  If you have problems with something, please
X# let me know.
X#
X# Compiled by:	Derek Atkins <warlord@MIT.EDU>
X#
X
X# MAILCMD contains the email address of the central site which will be
X# collecting relations. 
XMAILCMD= -DMAILCMD='"mail factor@hot-spare.mit.edu < %s"'
X
X# This is the directory in which to copy the binary when you "make install"
X# (Warning, make install will not create the binary as you would think
X# it should, as there is no dependency, and I don't know how to easily
X# make one!
XINSTALLDIR=/afs/sipb.mit.edu/project/factoring/.bin/@sys
X
X# Don't fiddle with MFLAGS unless you know what you're doing.
X# The easiest to change are MAILBATCH and REPORT, which govern how many
X# relations are batched up before mailing, and how often a status report
X# is issued.  The values below are reasonable on typical workstations.
X# You may reduce MAXSIEVE (to a minimum of 100000) to reduce memory 
X# requirements somewhat, but the siever will run more slowly
X#
X# To reduce memory requirements even more, set -DNO_SQRTKN=1 in MFLAGS.
X# If you do, you will save 2Mb RAM, but at a cost.  The RESTART file
X# *must* be present, and it will be read frequently, possibly increasing
X# disk IO or network traffic.  mpqs will also run more slowly -- perhaps
X# 50% slower.  If you use NO_SQRTKN, you should have MAXSIEVE=300000
X# or more -- as big as will fit.  Each 100,000 you add to MAXSIEVE
X# increases memory usage by 100k
X#
X# Some architectures have problems with the getrusage() function (HP-UX
X# has been reported as one).  This function is used only to put timing
X# data into the output log file and is not vital for mpqs to run.  Add
X# the flag -DNO_TIMING to MFLAGS if you don't want, or can't get timing data.
X
XREPORT=10
XMAXPOL=100000
XMAILBATCH=25
XMAXSIEVE=3000000
XSIEVEL=10
XRISC=-URISC
X
XMFLAGS= -DREPORT=$(REPORT) -DMAXPOL=$(MAXPOL) $(RISC) -DUSEHEX=1 \
X	-DMAILBATCH=$(MAILBATCH) -DMAXSIEVE=$(MAXSIEVE) -DSIEVEL=$(SIEVEL)
XCFLAGS= -O
XMAKE= make
XRM= rm -f
XCP= cp -p
XPROG= mpqs
X
X.c.o:
X	$(RM) $*.o
X	$(CC) -c $(CFLAGS) $(MFLAGS) $(MAILCMD) $*.c
X
X.s.o:
X	$(RM) $*.o 
X	$(AS) $(ASMFLAGS) -o $*.o $*.s
X
Xdefault:
X	@echo "Type make <system>, where <system> is one of:"
X	@echo "	DS_mpqs, S4_mpqs, S4a_mpqs, S4S_mpqs, VS_mpqs,"
X	@echo "	alpha_mpqs, HP_mpqs, HP_gcc_mpqs, rs6000_mpqs,"
X	@echo "	SGI1_mpqs, SGI2_mpqs, linux_mpqs, or Gen_mpqs"
X
X# This is the all-encompasing rule to make the program.  This should
X# work for all platforms, and let you know how you made it.
Xall:	$(OBJS)
X	$(CC) -o $(PROG) $(CFLAGS) $(MFLAGS) $(MAILCMD) $(OBJS) -lm $(LIBS)
X	touch $(FILE)
X
X# DECstations (R3000) running Ultrix.
X#  Do *not* use gcc, it generates markedly worse code.
X#
XDS_mpqs: mpqs.c lip.c
X	$(MAKE) all CFLAGS=-O4 OBJS="mpqs.c lip.c" FILE=made_DS_mpqs
X
X# Sun-4 (Sparc)
X# Use gcc if you have it, it's better than Sun's cc
XS4_mpqs: mpqs.c lip.c
X	$(MAKE) all CC=gcc CFLAGS=-O OBJS="mpqs.o lip.o" FILE=made_S4_mpqs
X
X# Sun-4 with assembler speed-up.  MAXSIEVE=850000 tested on SS10 w/ 1MB
X# cache.  This may not be right for you!
XS4a_mpqs: sparc-sunos.s mpqs.c lip.c
X	$(MAKE) all CC=gcc CFLAGS="-O -DCONTRIBUTION_8" ASMFLAGS="-P -DFPU" \
X	OBJS="mpqs.o lip.o sparc-sunos.o" MAXSIEVE=850000 FILE=made_S4a_mpqs
X
X# Sun-4 with assembler, small memory
XS4a_mpqs_small: sparc-sunos.s mpqs.c lip.c
X	$(MAKE) all CC=gcc CFLAGS="-O -DNO_SQRTKN -DCONTRIBUTION_8" \
X	ASMFLAGS="-P -DFPU" OBJS="mpqs.o lip.o sparc-sunos.o" \
X	FILE=made_S4a_mpqs_small PROG=mpqs_small MAXSIEVE=300000
X
X# A Sun-4 running SOLARIS, with assembler speed-up
XS4S_mpqs: sparc-solaris.s mpqs.c lip.c
X	$(MAKE) all CC=gcc CFLAGS="-O -DCONTRIBUTION_8" ASMFLAGS="-P -DFPU" \
X	OBJS="mpqs.o lip.o sparc-solaris.o" LIBS=/usr/ucblib/libucb.a \
X	FILE=made_S4S_mpqs
X
X# A Vax running BSD.
XVS_mpqs: mpqs.c lip.c
X	$(MAKE) all CC=gcc CFLAGS=-O6 MAXSIEVE=100000 OBJS="mpqs.o lip.o" \
X	FILE=made_VS_mpqs
X
X# An Alpha running OSF/1
Xalpha_mpqs: mpqs.c lip.c
X	$(MAKE) all CFLAGS=-O2 OBJS="mpqs.c lip.c" \
X	FILE=made_alpha_mpqs MAXSIEVE=850000
X
X# An RS/6000 running AIX (3.2)
Xrs6000_mpqs: mpqs.c lip.c
X	$(MAKE) all CFLAGS="-O -qmaxmem=10000" OBJS="mpqs.o lip.o" \
X	FILE=made_rs6000_mpqs
X
X# HP/UX (You cannot use standard native compiler. You need the spiffy,
X# 	expensive one, or use gcc ;-)
XHP_mpqs: mpqs.c lip.c
X	$(MAKE) all OBJS="mpqs.c lip.c" \
X	CFLAGS="-O -Aa -D_HPUX_SOURCE -DNO_TIMING" \
X	FILE=made_HP_mpqs
X
X# HP/UX with native, stupid compiler
XHP_gcc_mpqs: mpqs.c lip.c
X	$(MAKE) all CC=gcc OBJS="mpqs.o lip.o" \
X	CFLAGS="-O -D_HPUX_SOURCE -DNO_TIMING" FILE=made_HP_gcc_mpqs
X
X# SGI.  This will compile a more generic (r2000/3000 cmd set) mpqs
XSGI1_mpqs: mpqs.c lip.c
X	$(MAKE) all CFLAGS="-mips1 -O3 -G16" OBJS="mpqs.c lip.c" \
X	FILE=made_SGI1_mpqs
X
X# SGI.  This will compile for the r4000 only
XSGI2_mpqs: mpqs.c lip.c
X	$(MAKE) all CFLAGS="-mips2 -sopt -O3 -non_shared -G16 -kpicopt" \
X	OBJS="mpqs.c lip.c" FILE=made_SGI1_mpqs
X
X# Linux
Xlinux_mpqs: mpqs.c lip.c
X	$(MAKE) all OBJS="mpqs.o lip.o" CFLAGS="-O6" \
X	FILE=made_linux_mpqs
X	@echo "Rebuilding binary with shared libc"
X	$(RM) $(PROG)
X	$(CC) -o $(PROG) mpqs.o lip.o -lm
X
X# Generic Unix.  Use gcc if you wish.
X
XGen_mpqs: mpqs.c lip.c
X	$(CC) -O $(MFLAGS) $(MAILCMD) -o mpqs mpqs.c lip.c -lm
X	touch Gen_mpqs
X#
X# Set various compiler flags for testing new versions.
X#
XTFLAGS = -DREPORT=1 -DMAXPOL=10 -DUSEHEX=1 -DSIEVEL=10 \
X	-DMAXSIEVE=3000000 
X
X# tester depends on Makefile so we can change TFLAGS alone.
X
Xtester: mpqs.c lip.c Makefile
X	$(CC) -O2 -URISC $(TFLAGS) $(MAILCMD) -o tester mpqs.c lip.c -lm
X
X#
X# This is a crock, but I really don't care.
Xinstall:
X	$(CP) $(PROG) $(INSTALLDIR)
X
Xclean:
X	$(RM) $(PROG) *.o *~ *.bak made_*_mpqs
END_OF_FILE
if test 5710 -ne `wc -c <'src/Makefile'`; then
    echo shar: \"'src/Makefile'\" unpacked with wrong size!
fi
# end of 'src/Makefile'
fi
if test -f 'src/lip.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'src/lip.c'\"
else
echo shar: Extracting \"'src/lip.c'\" \(155766 characters\)
sed "s/^X//" >'src/lip.c' <<'END_OF_FILE'
X/*
X
XSigned arbitrary length long int package.
X
X	Copyright Arjen K. Lenstra, 1989
X
X	Bugs, questions, suggestions, additions, whatever, to
X		Arjen K. Lenstra
X		Room 2Q334
X		Bellcore
X		445 South Street
X		Morristown, NJ 07960
X
X		email: lenstra@flash.bellcore.com
X		tel: 201 829 4878
X		fax: 201 829 2645
X
X*/
X
X#include <stdio.h>
X#include <math.h>
X#include <signal.h>
X#include <sys/time.h>
X#include <sys/resource.h>
X#include "lip.h"
X
X#ifdef vax
X#include <sys/types.h>
X#endif
X
X#ifndef vax
X#include <malloc.h>
X#include <stddef.h>
X#endif
X
X#if defined(sparc) && defined(__svr4__)
X#include <sys/rusage.h>
X#endif /* SOLARIS */
X
X#ifdef NO_ALLOCATE
X# define ALLOCATE 0
X#else
X# define ALLOCATE 1
X#endif
X
X#ifdef PRT_REALLOC
X# undef PRT_REALLOC
X# define PRT_REALLOC 1
X#else
X# define PRT_REALLOC 0
X#endif
X
X#define BYTEL           8	/* 8 bits per byte */
X#ifdef __alpha
X#define SIZEOFLONG      8     /* set this to SIZEOFLONG */
X/* 60 bits doesn't work (explicit failure because of precision loss;
X   probably because IEEE double mantissas are 53 bits).
X   Why 52 doesn't work, I dunno (zmod seems to loop forever.  argh!) */
X#else
X#define SIZEOFLONG      4	/* set this to SIZEOFLONG */
X#endif
X#define NBITS           30	/* must be even and 0 < NBITS <BITSOFLONG */
X#define BITSOFLONG      (BYTEL*SIZEOFLONG)
X#define NBITSH          (NBITS>>1)
X#define RADIX           (1L<<NBITS)
X#define RADIXM          (RADIX-1)
X#define RADIXROOT       (1L<<NBITSH)
X#define RADIXROOTM      (RADIXROOT-1)
X#define LOG10RAD        (double)9.03089986991943585644	/* base 10 log(RADIX) */
X#define MAXDEPTH        20
X#define MULT_CROSS      30
X#define SQUARE_CROSS    30
X
X#define SIZE            20	/* SIZE*NBITS must be >= BITSOFLONG */
X
X#if (!(NBITS&1)&&(NBITS>0)&&(NBITS<BITSOFLONG)&&(SIZE*NBITS>=BITSOFLONG))
X
X#define LINE            68	/* approximate bound # digits per line */
X#define BUFSIZE         2048	/* at most 2048 characters per line */
X
X#define PRIMBND         16500	/* to generate primes <= (2*PRIMBND+1)^2 */
X
X/*Function prototypes for static internal functions.*/
Xstatic void zsubmul(
X	long r,
X	verylong a,
X	verylong b
X	);
X
Xstatic void hidetimer(
X	FILE *f,
X	long w
X	);
X
Xstatic void zhalt(
X	char *c
X	);
X
Xstatic void zaddls(
X	verylong a,
X	verylong b,
X	verylong c
X	);
X
Xstatic void zmstartint(
X        verylong n
X        );
X
Xstatic void zmkeep(
X        verylong n
X        );
X
Xstatic void zmback(
X        );
X
Xstatic void kar_mul(
X	verylong a,
X	verylong b,
X	verylong *c,
X	long shi
X	);
X
Xstatic void kar_sq(
X	verylong a,
X	verylong *c,
X	long shi
X	);
X
Xstatic long zxxeucl(
X	verylong ain,
X	verylong nin,
X	verylong *invv,
X	verylong *uu
X	);
X
Xstatic void mont_init_odd_power(
X	verylong a,
X	verylong *a_sq,
X	long m,
X	verylong **odd_a_power
X	);
X
Xstatic void init_odd_power(
X	verylong a,
X	verylong n,
X	verylong *a_sq,
X	long m,
X	verylong **odd_a_power
X	);
X
Xstatic void zsmexp(
X	long a,
X	verylong e,
X	verylong *bb
X	);
X
Xstatic void zpshift(
X	void
X	);
X
Xstatic void zrootnewton(
X	verylong a,
X	verylong *b,
X	long n
X	);
X
Xstatic long ph1set(
X	verylong n,
X	verylong *rap,
X	verylong *alpha,
X	verylong *mu,
X	verylong *x,
X	verylong *f
X	);
X
Xstatic long ph1exp(
X	verylong n,
X	verylong *x,
X	verylong e,
X	verylong rap,
X	verylong *f
X	);
X
Xstatic long ph1(
X	verylong n,
X	verylong *x,
X	long m,
X	verylong rap,
X	verylong *f
X	);
X
Xstatic long ph1toph2(
X	verylong n,
X	verylong *x,
X	verylong *y,
X	verylong *ra,
X	verylong alpha,
X	verylong mu,
X	verylong *f
X	);
X
Xstatic long ph2squ(
X	verylong n,
X	verylong x1s,
X	verylong y1s,
X	verylong *x2,
X	verylong *y2,
X	verylong ra,
X	verylong *f
X	);
X
Xstatic long ph2mul(
X	verylong n,
X	verylong x1s,
X	verylong y1s,
X	verylong x2s,
X	verylong y2s,
X	verylong *x3,
X	verylong *y3,
X	verylong ra,
X	verylong *f
X	);
X
Xstatic long ph2exp(
X	verylong n,
X	verylong x1,
X	verylong yy1,
X	verylong *x2,
X	verylong *y2,
X	long e,
X	verylong ra,
X	verylong *f
X	);
X
Xstatic long ph2set(
X	verylong n,
X	verylong x,
X	verylong y,
X	long te,
X	verylong ra,
X	verylong *f
X	);
X
Xstatic void ph2prec(
X	verylong n,
X	long n1,
X	long j
X	);
X
Xstatic void ph2eval(
X	verylong n,
X	long ind,
X	long n1,
X	long j,
X	verylong *result
X	);
X
Xstatic long ph2(
X	verylong n,
X	verylong inx,
X	verylong iny,
X	long m,
X	long te,
X	verylong ra,
X	verylong *f
X	);
X
Xstatic void message(
X	char *str,
X	double t
X	);
X
Xstatic long trial(
X	verylong n,
X	long m,
X	verylong *f,
X	long info
X	);
X
X
X#if 1
X/*
X	This definition of zaddmulp and zaddmulpsq presumes a two's complement
X	machine in which integer overflow is ignored and where double
X	precision arithmetic is fast. The 0.25 allows round to nearest
X	or round towards zero (value being rounded should be integer
X	except for roundoff.)
X*/
X
Xstatic double fradix_inv = 1.0 / RADIX;	/* Global constant */
X
X#define zaddmulp(_a, _b, _d, _t) \
X{ \
X	register at = *(_a) + *(_t); \
X	register long aa = (at + (_b) * (_d)) & RADIXM; \
X \
X	*(_t) = (long) (0.25 + fradix_inv * (((double) (at - aa)) \
X	               + ((double) (_b)) * ((double) (_d)))); \
X	*(_a) = aa; \
X}
X
X#define zaddmulpsq(_a, _b, _t) \
X{ \
X	register at = *(_a); \
X	register long aa = (at + (_b) * (_b)) & RADIXM; \
X \
X	*(_t) = (long) (0.25 + fradix_inv * (((double) (at - aa)) \
X				      + ((double) (_b)) * ((double) (_b)))); \
X	*(_a) = aa; \
X}
X#endif
X
X#if 0
X/*
X	This definition of zaddmulp and zaddmulpsq assumes nothing
X*/
X#define zaddmulp(_a, _b, _d, _t) \
X{ \
X	register long lb = (_b); \
X	register long ld = (_d); \
X	register long b1 = (_b) & RADIXROOTM; \
X	register long d1 = (_d) & RADIXROOTM; \
X	register long aa = *(_a) + b1 * d1; \
X \
X	b1 = b1 * (ld >>= NBITSH) + d1 * (lb >>= NBITSH) + (aa >> NBITSH); \
X	aa = (aa & RADIXROOTM) + ((b1 & RADIXROOTM) << NBITSH) + *(_t); \
X	*(_t) = ld * lb + (b1 >> NBITSH) + (aa >> NBITS); \
X	*(_a) = (aa & RADIXM); \
X}
X
X#define zaddmulpsq(_a, _b, _t) \
X{ \
X	register long lb = (_b); \
X	register long b1 = (_b) & RADIXROOTM; \
X	register long aa = *(_a) + b1 * b1; \
X \
X	b1 = (b1 * (lb >>= NBITSH) << 1) + (aa >> NBITSH); \
X	aa = (aa & RADIXROOTM) + ((b1 & RADIXROOTM) << NBITSH); \
X	*(_t) = lb * lb + (b1 >> NBITSH) + (aa >> NBITS); \
X	*(_a) = (aa & RADIXM); \
X}
X#endif
X
X#define zaddmulone(ama, amb) \
X{ \
X	register long lami; \
X	register long lams = 0; \
X	register verylong lama = (ama); \
X	register verylong lamb = (amb); \
X \
X	lams = 0; \
X	for (lami = (*lamb++); lami > 0; lami--) \
X	{ \
X		lams += (*lama + *lamb++); \
X		*lama++ = lams & RADIXM; \
X		lams >>= NBITS; \
X	} \
X	*lama += lams; \
X}
X
X#define zaddmul(ams, ama, amb) \
X{ \
X	register long lami; \
X	register long lams = (ams); \
X	register verylong lama = (ama); \
X	register verylong lamb = (amb); \
X	long lamcarry = 0; \
X \
X	for (lami = (*lamb++); lami > 0; lami--) \
X	{ \
X		zaddmulp(lama, *lamb, lams, &lamcarry); \
X	/* Be careful, the last lama is unnormalized */ \
X		lama++; \
X		lamb++; \
X	} \
X        *lama += lamcarry; \
X}
X
X#define zaddmulsq(sql, sqa, sqb) \
X{ \
X	register long lsqi = (sql); \
X	register long lsqs = *(sqb); \
X	register verylong lsqa = (sqa); \
X	register verylong lsqb = (sqb); \
X	long lsqcarry = 0; \
X \
X	lsqb++; \
X	for (; lsqi > 0; lsqi--) \
X	{ \
X		zaddmulp(lsqa, *lsqb, lsqs, &lsqcarry); \
X		lsqa++; \
X		lsqb++; \
X	} \
X	*lsqa += lsqcarry; \
X/* Be careful, the last lama is unnormalized */ \
X}
X
X#define zmmulp(mmpa, mmpb) \
X{ \
X	register verylong lmmpa = (mmpa); \
X	register verylong lmmpb = (mmpb); \
X	register long lmmi = (*lmmpa) >> NBITSH; \
X	register long lmmd = (*lmmpa) & RADIXROOTM; \
X	long zmmtemp = 0; \
X \
X	lmmd = (zminv1 * lmmd + (((zminv1 * lmmi + zminv2 * lmmd) & RADIXROOTM) << NBITSH)) & RADIXM; \
X	for (lmmi = *lmmpb++; lmmi > 0; lmmi--) \
X	{ \
X		zaddmulp(lmmpa, *lmmpb, lmmd, &zmmtemp); \
X		lmmpa++; \
X		*lmmpb++; \
X	} \
X	if (((*lmmpa += zmmtemp) & RADIX) > 0) \
X	{ \
X		(*lmmpa++) &= RADIXM; \
X		(*lmmpa)++; \
X	} \
X}
X
X#if 0
X/*
X	If you prefer you can replace the above macro's by C-routines ,
X	(or better, replace them by assembly versions). Here are some
X	examples, the rest follow easily.
X*/
X
Xvoid
Xzaddmulp(
X	verylong a,
X	long b,
X	long d,
X	verylong t
X	)
X{
X	register long b1 = b & RADIXROOTM;
X	register long d1 = d & RADIXROOTM;
X	register long aa = *a + b1 * d1;
X
X	b1 = b1 * (d >>= NBITSH) + d1 * (b >>= NBITSH) + (aa >> NBITSH);
X	aa = (aa & RADIXROOTM) + ((b1 & RADIXROOTM) << NBITSH) + *t;
X	*t = d * b + (b1 >> NBITSH) + (aa >> NBITS);
X	*a = (aa & RADIXM);
X}
X
Xvoid
Xzaddmul(
X	long d,
X	verylong a,
X	verylong b
X	)
X{
X	register long i;
X	long carry = 0;
X	verylong carrya = &carry;
X
X	for (i = (*b++); i > 0; i--)
X		zaddmulp(a++, *b++, d, carrya);
X	*a += carry;
X}
X
Xvoid
Xzaddmulone(
X	verylong a,
X	verylong b
X	)
X{
X	zaddmul(1, a, b);
X}
X
Xvoid
Xzmmulp(
X	verylong pa,
X	verylong pb
X	)
X{
X	register long i = (*pa) >> NBITSH;
X	register long d = (*pa) & RADIXROOTM;
X	long temp = 0;
X	extern long zminv1;
X	extern long zminv2;
X
X	d = (zminv1 * d + (((zminv1 * i + zminv2 * d) & RADIXROOTM) << NBITSH)) & RADIXM;
X	for (i = *pb++; i > 0; i--)
X		zaddmulp(pa++, *pb++, d, &temp);
X	if (((*pa += temp) & RADIX) > 0)
X	{
X		(*pa++) &= RADIXM;
X		(*pa)++;
X	}
X}
X#endif
X
X
X/* a[s:] -= d*b, optimize this one, a and b not at overlapping addresses */
X
Xstatic void
Xzsubmul(
X	long r,
X	verylong a,
X	verylong b
X	)
X{
X	register long rd = RADIX - r;
X	register long i;
X	long carry = RADIX;
X
X	for (i = (*b++); i > 0; i--)
X	{
X		zaddmulp(a, *b, rd, &carry);
X		a++;
X		carry += RADIXM - (*b++);
X	}
X	*a += carry - RADIX;	/* unnormalized */
X}
X
X/*
X	zdiv21 returns quot, numhigh so
X
X	quot = (numhigh*RADIX + numlow)/denom;
X	numhigh  = (numhigh*RADIX + numlow)%denom;
X
XAssumes 0 <= numhigh < denom < RADIX and 0 <= numlow < RADIX.
X*/
X
X#if 0
X
X#define zdiv21(numhigh, numlow, denom, deninv, quot) \
X{ \
X	register long lr21; \
X	register long lq21 = (long) (((fradix * (double) (numhigh)) \
X			 + (double) (numlow)) * (deninv)); \
X
X/* Following works in many two's complement architectures. */ \
X	lr21 = (numhigh << NBITS) + numlow - lq21 * denom; \
X	if (lr21 < 0) \
X	{ \
X		do \
X		{ \
X			lq21--; \
X		} while ((lr21 += denom) < 0); \
X	} \
X	else \
X	{ \
X		while (lr21 >= denom) \
X		{ \
X			lr21 -= denom; \
X			lq21++; \
X		}; \
X	} \
X	quot = lq21; \
X	numhigh = lr21; \
X}
X#else
X
X#define zdiv21(numhigh, numlow, denom, deninv, quot) \
X{ \
X	register long lr21; \
X	register long lq21 = (long) (((fradix * (double) (numhigh)) \
X			 + (double) (numlow)) * (deninv)); \
X	long lprodhigh = 0; \
X	long lprodlow = 0; \
X \
X	zaddmulp(&lprodlow, lq21, denom, &lprodhigh); \
X	lr21 = RADIX * (numhigh - lprodhigh) + (numlow - lprodlow); \
X	if (lr21 < 0) \
X	{ \
X		do \
X		{ \
X			lq21--; \
X		} while ((lr21 += denom) < 0); \
X	} \
X	else \
X	{ \
X		while (lr21 >= denom) \
X		{ \
X			lr21 -= denom; \
X			lq21++; \
X		}; \
X	} \
X	quot = lq21; \
X	numhigh = lr21; \
X}
X#endif
X
Xlong
Xzmulmods(
X	long a,
X	long b,
X	long n
X	)
X{
X	register long lqmul = (long) (((double)a) * ((double)b) / ((double)n));
X#if 0
X	register long lr;
X	long lprodhigh1 = 0;
X	long lprodhigh2 = 0;
X	long lprodlow1 = 0;
X	long lprodlow2 = 0;
X
X	zaddmulp(&lprodlow1, a, b, &lprodhigh1);
X	zaddmulp(&lprodlow2, lqmul, n, &lprodhigh2);
X	lr = RADIX * (lprodhigh1 - lprodhigh2) + (lprodlow1 - lprodlow2);
X#else
X/* Many machines compute the following modulo 2^32, which is OK */
X	register long lr = a * b - lqmul * n;
X
X#endif
X	while (lr >= n)
X		lr -= n;
X	while (lr < 0)
X		lr += n;
X	return (lr);
X}
X
X
X#ifdef __hpux
Xextern void *calloc();
X#else
Xextern void *calloc();
X#endif
X
X/* global variables */
X
X/* for pollard time outs */
Xstatic int time_flag = 0;
X/* for long division */
Xstatic double epsilon;
Xstatic double fradix = (double)RADIX, fudge = -1.0;
X/* for random generator */
Xstatic verylong zseed = 0;
Xstatic verylong zranp = 0;
Xstatic verylong zprroot = 0;
X/* for Montgomery multiplication */
Xstatic verylong zn = 0;
Xstatic verylong zoldzn = 0;
Xstatic verylong zr = 0;
Xstatic verylong zrr = 0;
Xstatic verylong zrrr = 0;
Xstatic verylong znm = 0;
Xstatic long znotinternal = 0;
Xstatic long zntop;
Xstatic long zminv1;
Xstatic long zminv2;
X/* for small prime genaration */
Xstatic short *lowsieve = 0;
Xstatic short *movesieve = 0;
Xstatic long pindex;
Xstatic long pshift = -1;
Xstatic long lastp = 0;
X/* for convenience */
Xstatic long oner[] = {1, 1, 1};
Xstatic long glosho[] = {1, 1, 0};
Xstatic verylong one = &oner[1];
X/* for m_ary exponentiation */
Xstatic verylong **exp_odd_powers = 0;
X/* for karatsuba */
Xstatic verylong kar_mem[5*MAXDEPTH];
Xstatic long kar_mem_initialized = 0;
X
Xdouble 
Xgetutime()
X{
X	struct rusage used;
X
X#ifndef __hpux
X	getrusage(RUSAGE_SELF, &used);
X#else	/* maybe delete in HPUX 9. */
X#include <syscall.h>
X	syscall(SYS_getrusage, RUSAGE_SELF, &used);
X#endif
X#if defined(sparc) && defined(__svr4__)
X	return (used.ru_utime.tv_sec + (used.ru_utime.tv_nsec) / 1e9);
X#else
X	return (used.ru_utime.tv_sec + (used.ru_utime.tv_usec) / 1e6);
X#endif /* SOLARIS */
X}
X
Xdouble 
Xgetstime()
X{
X	struct rusage used;
X
X#ifndef __hpux
X	getrusage(RUSAGE_SELF, &used);
X#else	/* maybe delete in HPUX 9. */
X#include <syscall.h>
X	syscall(SYS_getrusage, RUSAGE_SELF, &used);
X#endif
X#if defined(sparc) && defined(__svr4__)
X	return (used.ru_stime.tv_sec + (used.ru_stime.tv_nsec) / 1e9);
X#else
X	return (used.ru_stime.tv_sec + (used.ru_stime.tv_usec) / 1e6);
X#endif /* SOLARIS */
X}
X
Xdouble 
Xgettime()
X{
X	struct rusage used;
X
X#ifndef __hpux
X	getrusage(RUSAGE_SELF, &used);
X#else	/* maybe delete in HPUX 9. */
X#include <syscall.h>
X	syscall(SYS_getrusage, RUSAGE_SELF, &used);
X#endif
X	return (used.ru_utime.tv_sec + used.ru_stime.tv_sec +
X#if defined(sparc) && defined(__svr4__)
X		(used.ru_utime.tv_nsec + used.ru_stime.tv_nsec) / 1e9);
X#else
X		(used.ru_utime.tv_usec + used.ru_stime.tv_usec) / 1e6);
X#endif /* SOLARIS */
X}
X
Xstatic void
Xhidetimer(
X	FILE *f,
X	long what
X	)
X{
X	static double keep_time;
X	if (what)
X	{
X		fprintf(f,"%8.5lf sec.\n",gettime()-keep_time);
X		fflush(f);
X	}
X	else
X		keep_time = gettime();
X}
X
Xvoid
Xstarttime()
X{
X	hidetimer(stderr,0);
X}
X
Xvoid
Xprinttime(
X	FILE *f
X	)
X{
X	hidetimer(f,1);
X}
X
Xstatic void
Xzhalt(
X        char *c
X	)
X{
X#ifdef NOHALT
X	fprintf(stderr,"error:\n   %s\ncontinue...\n",c);
X	fflush(stderr);
X#else
X	fprintf(stderr,"fatal error:\n   %s\nexit...\n",c);
X	fflush(stderr);
X	(void)exit((int)0);
X#endif
X}
X
Xvoid
Xzsetlength(
X	verylong *v,
X	long len,
X	char *str
X	)
X{
X	verylong x = *v;
X
X	if (x)
X	{
X		if (len <= x[-1])
X			return;
X		if (PRT_REALLOC)
X		{
X			fprintf(stderr,"%s reallocating to %ld\n", str, len);
X			fflush(stderr);
X		}
X		x[-1] = len;
X		if (!(x = (verylong)realloc((void*)(&(x[-1])), (size_t)(len + 2) * SIZEOFLONG)))
X		{
X			fprintf(stderr,"%d bytes realloc failed\n", ((int)len + 2) * SIZEOFLONG);
X			zhalt("reallocation failed in zsetlength");
X		}
X	}
X	else if (len >= 0)
X	{
X		if (len < SIZE)
X			len = SIZE;
X		if (PRT_REALLOC)
X		{
X			fprintf(stderr,"%s allocating to %ld\n", str, len);
X			fflush(stderr);
X		}
X		if (!(x = (verylong)calloc((size_t)(len + 2), (size_t)SIZEOFLONG)))
X		{
X			fprintf(stderr,"%d bytes calloc failed\n", ((int)len + 2) * SIZEOFLONG);
X			zhalt("allocation failed in zsetlength");
X		}
X		x[0] = len;
X		x[1] = 1;
X		x[2] = 0;
X	}
X	else
X		zhalt("negative size allocation in zsetlength");
X	x++;
X	*v = x;
X}
X
Xvoid
Xzfree(
X	verylong *x
X	)
X{
X	if (!(*x))
X		return;
X	{
X		verylong y = (*x - 1);
X		free((void*)y);
X		*x = 0;
X		return;
X	}
X}
X
Xdouble 
Xzdoub(
X	verylong n
X	)
X{
X	double res;
X	register long i;
X
X	if (ALLOCATE && !n)
X		return ((double) 0);
X	if ((i = n[0]) < 0)
X		i = -i;
X	res = (double) (n[i--]);
X	for (; i; i--)
X		res = res * fradix + (double) (n[i]);
X	if (n[0] > 0)
X		return (res);
X	return (-res);
X}
X
Xvoid
Xzstart()
X{
X	double local_one = (double) 1;
X	double local_half = 1 / (double) 2;
X	epsilon = local_one;
X	fudge = local_one + epsilon;
X
X /* the following loop is sick, but we have to: */
X /* comparing one to one + epsilon does not have */
X /* the desired effect on some machines, because */
X /* one + epsilon is Not cast to double (as it should) */
X	while (local_one != fudge)
X	{
X		epsilon = epsilon * local_half;
X		fudge = local_one + epsilon;
X	}
X	epsilon += epsilon;
X	if ((epsilon * RADIX) > local_one)
X	{
X		zhalt("recompile with smaller NBITS");
X	}
X	else
X		epsilon *= 3;
X	fudge = fradix + epsilon * fradix;
X}
X
Xvoid
Xzzero(
X	verylong *aa
X	)
X{
X	if (!(*aa)) zsetlength(aa, (long)SIZE, "in zzero, first argument");
X	(*aa)[0] = (long) 1;
X	(*aa)[1] = (long) 0;
X}
X
Xvoid
Xzone(
X	verylong *aa
X	)
X{
X	if (!(*aa)) zsetlength(aa, (long)SIZE, "in zone, first argument");
X	(*aa)[0] = (long) 1;
X	(*aa)[1] = (long) 1;
X}
X
Xvoid
Xzcopy(
X	verylong a,
X	verylong *bb
X	)
X{
X	register long i;
X	verylong b = *bb;
X
X	if (ALLOCATE && !a)
X	{
X		zzero(bb);
X		return;
X	}
X	if (a != b)
X	{
X		if ((i = *a) < 0)
X			i = (-i);
X		zsetlength(&b, i, "in zcopy, second argument");
X		*bb = b;
X		for (; i >= 0; i--)
X			*b++ = *a++;
X	}
X}
X
Xvoid
Xzintoz(
X	long d,
X	verylong *aa
X	)
X{
X	register long i = 0;
X	register long anegative = 0;
X	verylong a = *aa;
X
X	if (!(*aa)) zsetlength(&a, (long)SIZE, "in zintoz, second argument");
X	*aa = a;
X	if (d < 0)
X	{
X		anegative = 1;
X		d = -d;
X	}
X	a[1] = 0;
X	while (d > 0)
X	{
X		a[++i] = d & RADIXM;
X		d >>= NBITS;
X	}
X	if (i > 0)
X		a[0] = i;
X	else
X		a[0] = 1;
X	if (anegative)
X		a[0] = (-a[0]);
X}
X
Xlong 
Xztoint(
X	verylong a
X	)
X{
X	register long d;
X	register long sa;
X
X	if (ALLOCATE && !a)
X		return (0);
X	if ((sa = *a) < 0)
X		sa = -sa;
X	d = *(a += sa);
X	while (--sa)
X	{
X		d <<= NBITS;
X		d += *(--a);
X	}
X	if ((*(--a)) < 0)
X		return (-d);
X	return (d);
X}
X
Xvoid
Xzsbastoz(
X	long base,
X	long row[],
X	long len,
X	verylong *n
X	)
X{
X	register long i;
X
X	zintoz(row[len - 1], n);
X	for (i = len - 1; i--;)
X	{
X		zsmul(*n, base, n);
X		zsadd(*n, row[i], n);
X	}
X}
X
Xvoid
Xzbastoz(
X	verylong base,
X	verylong row[],
X	long len,
X	verylong *n
X	)
X{
X	register long i;
X
X	zcopy(row[len - 1], n);
X	for (i = len - 1; i--;)
X	{
X		zmulin(base, n);
X		zadd(*n, row[i], n);
X	}
X}
X
Xlong 
Xzstobas(
X	verylong n,
X	long base,
X	long row[],
X	long *len
X	)
X{
X /* return 1 if it fits, 0 otherwise */
X /* n >= 0, base > 1 */
X	register long i = 0;
X	register long max = *len;
X	static verylong q = 0;
X	static verylong nn = 0;
X
X	if (max < 1)
X		return (0);
X	if (base < 0)
X		base = -base;
X	if (base <= 1)
X		return (0);
X	*len = 0;
X	row[0] = 0;
X	zcopy(n, &nn);
X	zabs(&nn);
X	for (;;)
X	{
X		row[i] = zsdiv(nn, base, &q);
X		i++;
X		if ((q[1] == 0) && (q[0] == 1))
X		{
X			*len = i;
X			return (1);
X		}
X		if (i == max)
X			return (0);
X		zswap(&q, &nn);
X	}
X}
X
Xlong 
Xzstosymbas(
X	verylong n,
X	long base,
X	long row[],
X	long *len
X	)
X{
X /* return 1 if it fits, 0 otherwise */
X /* n >= 0, base > 1 */
X	register long i = 0;
X	register long max = *len;
X	register long hbase;
X	static verylong q = 0;
X	static verylong nn = 0;
X
X	if (max < 1)
X		return (0);
X	if (base < 0)
X		base = -base;
X	if (base <= 1)
X		return (0);
X	hbase = (base >> 1);
X	*len = 0;
X	row[0] = 0;
X	zcopy(n, &nn);
X	zabs(&nn);
X	for (;;)
X	{
X		if ((row[i] = zsdiv(nn, base, &q)) > hbase)
X		{
X			row[i] -= base;
X			zsadd(q, 1, &q);
X		}
X		i++;
X		if ((q[1] == 0) && (q[0] == 1))
X		{
X			*len = i;
X			return (1);
X		}
X		if (i == max)
X			return (0);
X		zswap(&q, &nn);
X	}
X}
X
Xlong 
Xztobas(
X	verylong n,
X	verylong base,
X	verylong row[],
X	long *len
X	)
X{
X /* return 1 if it fits, 0 otherwise */
X /* n >= 0, base > 1 */
X	register long i = 0;
X	register long max = *len;
X	static verylong q = 0;
X	static verylong nn = 0;
X	static verylong lbase = 0;
X
X	if (max < 1)
X		return (0);
X	zcopy(base, &lbase);
X	zabs(&lbase);
X	if (zscompare(base, 1) <= 0)
X		return (0);
X	*len = 0;
X	zintoz(0, &(row[0]));
X	zcopy(n, &nn);
X	zabs(&nn);
X	for (;;)
X	{
X		zdiv(nn, lbase, &q, &(row[i]));
X		i++;
X		if ((q[1] == 0) && (q[0] == 1))
X		{
X			*len = i;
X			return (1);
X		}
X		if (i == max)
X			return (0);
X		zswap(&q, &nn);
X	}
X}
X
Xlong 
Xztosymbas(
X	verylong n,
X	verylong base,
X	verylong row[],
X	long *len
X	)
X{
X /* return 1 if it fits, 0 otherwise */
X /* n >= 0, base > 1 */
X	register long i = 0;
X	register long max = *len;
X	static verylong q = 0;
X	static verylong nn = 0;
X	static verylong lbase = 0;
X	static verylong hbase = 0;
X
X	if (max < 1)
X		return (0);
X	zcopy(base, &lbase);
X	zabs(&lbase);
X	if (zscompare(base, 1) <= 0)
X		return (0);
X	z2div(lbase, &hbase);
X	*len = 0;
X	zintoz(0, &(row[0]));
X	zcopy(n, &nn);
X	zabs(&nn);
X	for (;;)
X	{
X		zdiv(nn, lbase, &q, &(row[i]));
X		if (zcompare(row[i], hbase) > 0)
X		{
X			zsub(row[i], lbase, &(row[i]));
X			zsadd(q, 1, &q);
X		}
X		i++;
X		if ((q[1] == 0) && (q[0] == 1))
X		{
X			*len = i;
X			return (1);
X		}
X		if (i == max)
X			return (0);
X		zswap(&q, &nn);
X	}
X}
X
Xlong 
Xzcompare(
X	verylong a,
X	verylong b
X	)
X{
X	register long sa;
X	register long sb;
X
X	if (ALLOCATE && !a)
X	{
X		if (!b)
X			return (0);
X		if (b[0] < 0)
X			return (1);
X		if (b[0] > 1)
X			return (-1);
X		if (b[1])
X			return (-1);
X		return (0);
X	}
X	if (ALLOCATE && !b)
X	{
X		if (a[0] < 0)
X			return (-1);
X		if (a[0] > 1)
X			return (1);
X		if (a[1])
X			return (1);
X		return (0);
X	}
X /* if (a==b) return (0); but who is comparing identical addresses? */
X	if ((sa = *a) > (sb = *b))
X		return (1);
X	if (sa < sb)
X		return (-1);
X	if (sa < 0)
X		sa = (-sa);
X	a += sa;
X	b += sa;
X	for (; sa; sa--)
X	{
X		if (*a > *b)
X		{
X			if (sb < 0)
X				return (-1);
X			return (1);
X		}
X		if (*a-- < *b--)
X		{
X			if (sb < 0)
X				return (1);
X			return (-1);
X		}
X	/*
X	 * depending on the relative speed of various operations it might be
X	 * better to do the following: if ((aux=(*a--)-(*b--))>0) { if (sb<0)
X	 * return (-1); return (1); } else if (aux<0) { if (sb<0) return (1);
X	 * return (-1); } where aux is a register long
X	 */
X	}
X	return (0);
X}
X
Xvoid
Xznegate(
X	verylong *aa
X	)
X{
X	verylong a = *aa;
X
X	if (!a)
X		return;
X	if (a[1] || a[0] != 1)
X		a[0] = (-a[0]);
X}
X
Xvoid
Xzsadd(
X	verylong a,
X	long d,
X	verylong *b
X	)
X{
X	static verylong x = 0;
X
X	zintoz(d, &x);
X	zadd(a, x, b);
X}
X
Xstatic void
Xzaddls(
X	verylong a,
X	verylong b,
X	verylong c
X	)
X{
X/* low level c = a+b, b shorter than a, output can be input */
X	register long sa = *a;
X	register long sb = *b;
X	register long carry = 0;
X	register long i;
X	register verylong pc;
X
X /* we know that sa and sb are both >0 or both <0 */
X	pc = &c[0];
X	if (sa < 0)
X	{
X		sa = -sa;
X		sb = -sb;
X	}
X	for (i = 1; i <= sb; i++)
X	{
X		if ((*(++pc) = (*(++a)) + (*(++b)) + carry) < RADIX)
X			carry = 0;
X		else
X		{
X			*pc -= RADIX;
X			carry = 1;
X		}
X	}
X	for (; i <= sa; i++)
X	{
X		if ((*(++pc) = (*(++a)) + carry) < RADIX)
X			carry = 0;
X		else
X		{
X			*pc -= RADIX;
X			carry = 1;
X		}
X	}
X	if (carry)
X	{
X		c[0] = sa + 1;
X		*(++pc) = 1;
X	}
X	else
X		c[0] = sa;
X}
X
Xvoid
Xzsubpos(
X	verylong a,
X	verylong b,
X	verylong *cc
X	)
X{
X	register long sa = a[0];
X	register long sb = b[0];
X	register long carry = 0;
X	register long i;
X	register verylong pc;
X	verylong c = *cc;
X
X	if (ALLOCATE && !b)
X	{
X		if (a)
X			zcopy(a, cc);
X		else
X			zzero(cc);
X		return;
X	}
X	if (ALLOCATE && !a)
X	{
X		zzero(cc);
X		return;
X	}
X	zsetlength(&c, sa, "in zsubpos, third argument");
X	/* if *cc == a, then nothing will happen */
X	/* if *cc == b, then b might point to freed space, so */
X	if (b == *cc) b = c;
X	*cc = c;
X	pc = &c[0];
X	for (i = 1; i <= sb; i++)
X	{
X		if ((*(++pc) = (*(++a)) - (*(++b)) - carry) >= 0)
X			carry = 0;
X		else
X		{
X			*pc += RADIX;
X			carry = 1;
X		};
X	}
X	for (; i <= sa; i++)
X	{
X		if ((*(++pc) = (*(++a)) - carry) >= 0)
X			carry = 0;
X		else
X		{
X			*pc += RADIX;
X			carry = 1;
X		};
X	}
X	i = sa;
X	while ((i > 1) && (!(*pc)))
X	{
X		i--;
X		pc--;
X	}
X	c[0] = i;
X}
X
Xvoid
Xzadd(
X	verylong a,
X	verylong b,
X	verylong *cc
X	)
X{
X	register long sa;
X	register long sb;
X	register long anegative;
X	verylong c = *cc;
X
X	if (ALLOCATE && !a)
X	{
X		if (b)
X			zcopy(b, cc);
X		else
X			zzero(cc);
X		return;
X	}
X	if (ALLOCATE && !b)
X	{
X		zcopy(a, cc);
X		return;
X	}
X	if ((anegative = ((sa = a[0]) < 0)) == ((sb = b[0]) < 0))
X	{
X	/* signs a and b are the same */
X		register long i;
X		if (anegative)
X		{
X			sa = -sa;
X			sb = -sb;
X		}
X		zsetlength(&c, (sa > sb ? sa : sb) + 1, "in zadd, third argument");
X		if (a == *cc) a = c;
X		if (b == *cc) b = c;
X		*cc = c;
X		if (sa == sb)
X		{
X			register verylong pc;
X			pc = &c[0];
X			i = 0;
X			for (; sa; sa--)
X			{
X				if ((*(++pc) = (*(++a)) + (*(++b)) + i) < RADIX)
X					i = 0;
X				else
X				{
X					*pc -= RADIX;
X					i = 1;
X				}
X			}
X			if (i)
X			{
X				c[0] = sb + 1;
X				*(++pc) = 1;
X			}
X			else
X				c[0] = sb;
X		}
X		else if (sa > sb)
X			zaddls(a, b, c);
X		else
X			zaddls(b, a, c);
X		if (anegative)
X			c[0] = -c[0];
X	/* if anegative, then c cannot be zero */
X	}
X	else
X	{
X	/* signs a and b are different */
X		verylong old;
X		verylong oldc;
X
X		oldc = c;
X		if (anegative)
X		{
X			a[0] = -a[0];
X			old = a;
X		}
X		else
X		{
X			b[0] = -b[0];
X			old = b;
X		}
X	/* the one that's negative cannot be zero */
X		if (!(sa = zcompare(a, b)))
X		{
X			zzero(&c);
X			*cc = c;
X			if (anegative)
X			{
X				if (old != oldc)
X					a[0] = -a[0];
X			}
X			else if (old != oldc)
X				b[0] = -b[0];
X		}
X		else if (sa > 0)
X		{
X			zsubpos(a, b, &c);
X			*cc = c;
X			if (anegative)
X			{
X				c[0] = -c[0];
X				if (old != oldc)
X					a[0] = -a[0];
X			}
X			else if (old != oldc)
X				b[0] = -b[0];
X		}
X		else
X		{
X			zsubpos(b, a, &c);
X			*cc = c;
X			if (!anegative)
X			{
X				c[0] = -c[0];
X				if (old != oldc)
X					b[0] = -b[0];
X			}
X			else if (old != oldc)
X				a[0] = -a[0];
X		}
X	}
X}
X
Xvoid
Xzsub(
X	verylong a,
X	verylong b,
X	verylong *cc
X	)
X{
X	register long sa;
X	register long sb;
X	register long anegative;
X	verylong c = *cc;
X
X	if (ALLOCATE && !b)
X	{
X		if (a)
X			zcopy(a, cc);
X		else
X			zzero(cc);
X		return;
X	}
X	if (ALLOCATE && !a)
X	{
X		zcopy(b, cc);
X		znegate(cc);
X		return;
X	}
X	if ((anegative = ((sa = a[0]) < 0)) == ((sb = b[0]) < 0))
X	{
X	/* signs a and b are the same */
X		register long carry = 0;
X		register long i;
X		register verylong pc;
X		register long agrb;
X
X		if (!(agrb = zcompare(a, b)))
X		{
X			zzero(cc);
X			return;
X		}
X		if ((agrb > 0 && anegative) || (agrb < 0 && !anegative))
X		{
X			pc = a;
X			a = b;
X			b = pc;
X			sa = *a;
X			sb = *b;
X		}
X		if (anegative)
X		{
X			sa = -sa;
X			sb = -sb;
X		}
X		zsetlength(&c, sa, "in zsub, third argument");
X                if (b == *cc) b = c;
X		*cc = c;
X		pc = &c[0];
X		for (i = 1; i <= sb; i++)
X		{
X			if ((*(++pc) = (*(++a)) - (*(++b)) - carry) >= 0)
X				carry = 0;
X			else
X			{
X				*pc += RADIX;
X				carry = 1;
X			};
X		}
X		for (; i <= sa; i++)
X		{
X			if ((*(++pc) = (*(++a)) - carry) >= 0)
X				carry = 0;
X			else
X			{
X				*pc += RADIX;
X				carry = 1;
X			};
X		}
X		i = sa;
X		while ((i > 1) && (!(*pc)))
X		{
X			i--;
X			pc--;
X		}
X		if (agrb > 0)
X			c[0] = i;
X		else
X			c[0] = -i;
X	}
X	else
X	{
X	/* signs a and b are different */
X		verylong old;
X		verylong oldc;
X
X		oldc = c;
X		if (anegative)
X		{
X			a[0] = -a[0];
X			old = a;
X		}
X		else
X		{
X			b[0] = -b[0];
X			old = b;
X		}
X	/* the one that's negative cannot be zero */
X		zadd(a, b, &c);
X		*cc = c;
X		if (anegative)
X		{
X			c[0] = -c[0];
X			if (old != oldc)
X				a[0] = -a[0];
X		}
X		else if (old != oldc)
X			b[0] = -b[0];
X	}
X}
X
Xvoid
Xzsmul(
X	verylong a,
X	long d,
X	verylong *bb
X	)
X{
X	register long sa;
X	register long i;
X	register verylong pb;
X	register long bnegative = 0;
X	verylong b = *bb;
X	static verylong x = 0;
X
X	if (( d >= RADIX) || (-d >= RADIX)) {
X		zintoz(d,&x);
X		zmulin(a,&x);
X		zcopy(x,bb);
X		return;
X	}
X
X	if (ALLOCATE && !a)
X	{
X		zzero(bb);
X		return;
X	}
X	if (ALLOCATE && !d)
X	{
X		zzero(bb);
X		return;
X	}
X	if ((sa = a[0]) < 0)
X	{
X		sa = (-sa);
X		if (d < 0)
X			d = (-d);
X		else
X			bnegative = 1;
X	}
X	else if (bnegative = (d < 0))
X		d = (-d);
X	zsetlength(&b, sa + 1, "in zsmul, third argument");
X        if (a == *bb) a = b;
X	*bb = b;
X	pb = &b[0];
X	for (i = sa; i >= 0; i--)
X		*pb++ = *a++;
X	b[0] = sa;
X	sa++;
X	*pb = 0;
X	zaddmul(d - 1, &b[1], &b[0]);
X	while ((sa > 1) && (!(b[sa])))
X		sa--;
X	b[0] = sa;
X	if (bnegative && (b[1] || b[0] != 1))
X		b[0] = (-b[0]);
X}
X
Xstatic void
Xkar_mul(
X	verylong a,
X	verylong b,
X	verylong *c,
X	long shi
X	)
X{
X	register long al;
X	register long hal;
X	register long i;
X	register long restoreb0 = b[0];
X	register verylong pc;
X	register long bbig = 1;
X	verylong *a0;
X	verylong *a1;
X	verylong *a2;
X	verylong *a3;
X	verylong *a4;
X
X	zsetlength(c, (hal = (al = a[0]) + (i = b[0])), "in kar_mul, third argument");
X	if ((shi >= (5 * MAXDEPTH)) || (al < MULT_CROSS) || (i < MULT_CROSS))
X	{
X		pc = &(*c)[1];
X		for (i = hal; i > 0; i--)
X			*pc++ = 0;
X		pc = &(*c)[1];
X		if (al <= *b)
X			for (i = al; i; i--)
X			{
X				zaddmul(*(++a), pc++, b);
X			}
X		else
X			for (i = *b; i; i--)
X			{
X				zaddmul(*(++b), pc++, a);
X			}
X		while ((hal > 1) && (!((*c)[hal])))
X			hal--;
X		(*c)[0] = hal;
X		return;
X	}
X	a0 = &(kar_mem[shi]);
X	a1 = &(kar_mem[shi + 1]);
X	a2 = &(kar_mem[shi + 2]);
X	a3 = &(kar_mem[shi + 3]);
X	a4 = &(kar_mem[shi + 4]);
X	hal = ((al + 1) >> 1);
X	zsetlength(a0, al, "in kar_mul, locals\n");
X	zsetlength(a1, al, "");
X	zsetlength(a2, al, "");
X	zsetlength(a3, al + hal, "");
X	zsetlength(a4, al + 2, "");
X	i = hal;
X	while ((i > 1) && (!(a[i])))
X		i--;
X	a[0] = i;
X	if (hal >= b[0])
X		bbig = 0;
X	else
X	{
X		i = hal;
X		while ((i > 1) && (!(b[i])))
X			i--;
X		b[0] = i;
X	}
X	for (i = hal + 1; i <= al; i++)
X		(*a1)[i - hal] = a[i];
X	(*a1)[0] = al - hal;
X	if (bbig)
X	{
X		for (i = hal + 1; i <= restoreb0; i++)
X			(*a3)[i - hal] = b[i];
X		(*a3)[0] = restoreb0 - hal;
X	}
X	kar_mul(a, b, a4, shi + 5);
X	zadd(a, (*a1), a0);
X	a[0] = al;
X	if (bbig)
X	{
X		kar_mul((*a1), (*a3), c, shi + 5);
X		zadd(b, (*a3), a2);
X		b[0] = restoreb0;
X		kar_mul((*a0), (*a2), a3, shi + 5);
X	}
X	else
X		kar_mul((*a0), b, a3, shi + 5);
X	zsubpos((*a3), (*a4), a3);
X	if (bbig)
X		zsubpos((*a3), *c, a3);
X	zlshift((*a3), hal * NBITS, a3);
X	hal <<= 1;
X	if (bbig)
X	{
X		for (i = (*c)[0]; i; i--)
X			(*c)[i + hal] = (*c)[i];
X		for (i = hal; i > (*a4)[0]; i--)
X			(*c)[i] = 0;
X		for (; i; i--)
X			(*c)[i] = (*a4)[i];
X		(*c)[0] += hal;
X	}
X	else
X	{
X		for (i = (*a4)[0]; i >= 0; i--)
X			(*c)[i] = (*a4)[i];
X	}
X	zadd(*c, (*a3), c);
X}
X
Xvoid
Xzmul(
X	verylong a,
X	verylong b,
X	verylong *c
X	)
X{	/* output not input */
X	register long aneg;
X	register long bneg;
X	verylong olda;
X	verylong oldb;
X
X	if (ALLOCATE && (!a || !b))
X	{
X		zzero(c);
X		return;
X	}
X	if (a == b)
X	{
X		zsq(a, c);
X		return;
X	}
X	if (!kar_mem_initialized)
X	{
X		kar_mem_initialized = 1;
X		for (aneg = (5 * MAXDEPTH) - 1; aneg >= 0; aneg--)
X			kar_mem[aneg] = (verylong) 0;
X	}
X	olda = a;
X	oldb = b;
X	if (aneg = (*a < 0))
X		a[0] = -a[0];
X	if (bneg = (*b < 0))
X		b[0] = -b[0];
X	if (*a > *b)
X		kar_mul(a, b, c, (long) 0);
X	else
X		kar_mul(b, a, c, (long) 0);
X	if (aneg != bneg && ((*c)[1] || (*c)[0] != 1))
X		(*c)[0] = -(*c)[0];
X	if (aneg)
X		olda[0] = -olda[0];
X	if (bneg)
X		oldb[0] = -oldb[0];
X}
X
Xstatic void
Xkar_sq(
X	verylong a,
X	verylong *c,
X	long shi
X	)
X{
X	register long al;
X	register long hal;
X	register long i;
X	register verylong pc;
X	verylong *a0;
X	verylong *a1;
X	verylong *a2;
X
X	zsetlength(c, (i = ((al = a[0]) << 1)), "in kar_sq, second argument");
X	if ((shi >= (3 * MAXDEPTH)) || (al < SQUARE_CROSS))
X	{
X		register unsigned long uncar;
X		long carry = 0;
X		pc = &(*c)[1];
X		for (; i > 0; i--)
X			*pc++ = 0;
X		for (hal = 1; hal <= al; hal++)
X		{
X			i += 2;
X			{
X				zaddmulsq(al - hal, &((*c)[i]), &(a[hal]));
X			}
X			uncar = ((*c)[i - 1] << 1) + carry;
X			(*c)[i - 1] = uncar & RADIXM;
X			uncar = ((*c)[i] << 1) + (uncar >> NBITS);
X			{
X				zaddmulpsq(&(*c)[i - 1], a[hal], &carry);
X			}
X			uncar += carry;
X			carry = uncar >> NBITS;
X			(*c)[i] = uncar & RADIXM;
X		}
X		while ((i > 1) && (!((*c)[i])))
X			i--;
X		(*c)[0] = i;
X		return;
X	}
X	a0 = &(kar_mem[shi]);
X	a1 = &(kar_mem[shi + 1]);
X	a2 = &(kar_mem[shi + 2]);
X	hal = ((al + 1) >> 1);
X	zsetlength(a0, al + hal + 2, "in kar_sq, locals\n");
X	zsetlength(a1, al + 2, "");
X	zsetlength(a2, al, "");
X	i = hal;
X	while ((i > 1) && (!(a[i])))
X		i--;
X	a[0] = i;
X	for (i = hal + 1; i <= al; i++)
X		(*a0)[i - hal] = a[i];
X	(*a0)[0] = al - hal;
X	kar_sq(a, a1, shi + 3);
X	zadd(a, (*a0), a2);
X	kar_sq((*a0), c, shi + 3);
X	a[0] = al;
X	kar_sq((*a2), a0, shi + 3);
X	zsubpos((*a0), (*a1), a0);
X	zsubpos((*a0), *c, a0);
X	zlshift((*a0), hal * NBITS, a0);
X	hal <<= 1;
X	for (i = (*c)[0]; i; i--)
X		(*c)[i + hal] = (*c)[i];
X	for (i = hal; i > (*a1)[0]; i--)
X		(*c)[i] = 0;
X	for (; i; i--)
X		(*c)[i] = (*a1)[i];
X	(*c)[0] += hal;
X	zadd(*c, (*a0), c);
X}
X
Xvoid
Xzsq(
X	verylong a,
X	verylong *c
X	)
X{	/* output is not input */
X	register long aneg;
X
X	if (ALLOCATE && !a)
X	{
X		zzero(c);
X		return;
X	}
X        if (!kar_mem_initialized)
X        {
X                kar_mem_initialized = 1;
X                for (aneg = (5 * MAXDEPTH) - 1; aneg >= 0; aneg--)
X                        kar_mem[aneg] = (verylong) 0;
X        }
X	if (aneg = (*a < 0))
X		a[0] = -a[0];
X	kar_sq(a, c, (long) 0);
X	if (aneg)
X		a[0] = -a[0];
X}
X
Xvoid
Xzmul_plain(
X	verylong a,
X	verylong b,
X	verylong *cc
X	)
X{
X	register long i;
X	register verylong pc;
X	register long sc;
X	verylong c = *cc;
X	long anegative;
X	long bnegative;
X	verylong olda;
X	verylong oldb;
X
X	if (ALLOCATE && (!a || !b))
X	{
X		zzero(cc);
X		return;
X	}
X	olda = a;
X	oldb = b;
X	if (anegative = (*a < 0))
X		a[0] = -a[0];
X	if (olda == oldb)
X		bnegative = anegative;
X	else if (bnegative = (*b < 0))
X		b[0] = -b[0];
X	zsetlength(&c, (sc = *a + *b), "in zmul_plain, third argument");
X	*cc = c;
X	pc = &c[1];
X	for (i = sc; i > 0; i--)
X		*pc++ = 0;
X	pc = &c[1];
X	if (*a <= *b)
X		for (i = *a; i; i--)
X		{
X			zaddmul(*(++a), pc++, b);
X		}
X	else
X		for (i = *b; i; i--)
X		{
X			zaddmul(*(++b), pc++, a);
X		}
X	while ((sc > 1) && (!(c[sc])))
X		sc--;
X	c[0] = sc;
X	if (anegative != bnegative && (c[1] || c[0] != 1))
X		c[0] = -c[0];
X	if (anegative)
X		olda[0] = -olda[0];
X	if (bnegative && oldb != olda)
X		oldb[0] = -oldb[0];
X}
X
Xvoid
Xzmulin(
X	verylong b,
X	verylong *a
X	)
X{
X	static verylong mem = 0;
X
X	if (ALLOCATE && (!*a || !b))
X	{
X		zzero(a);
X		return;
X	}
X	zcopy(*a, &mem);
X	zmul(mem, b, a);
X}
X
Xvoid
Xzsq_plain(
X	verylong a,
X	verylong *cc
X	)
X{
X	register long i;
X	register long sc;
X	register verylong pc;
X	register unsigned long uncar;
X	long carry = 0;
X	verylong c = *cc;
X	long anegative;
X
X	if (ALLOCATE && !a)
X	{
X		zzero(cc);
X		return;
X	}
X	if ((anegative = (*a)) < 0)
X		anegative = -anegative;
X	zsetlength(&c, (sc = 2 * anegative), "in zsq_plain, second argument");
X	*cc = c;
X	pc = &c[1];
X	for (i = sc; i > 0; i--)
X		*pc++ = 0;
X	for (sc = 1; sc <= anegative; sc++)
X	{
X		i += 2;
X		{
X			zaddmulsq(anegative - sc, &(c[i]), &(a[sc]));
X		}
X		uncar = (c[i - 1] << 1) + carry;
X		c[i - 1] = uncar & RADIXM;
X		uncar = (c[i] << 1) + (uncar >> NBITS);
X		{
X			zaddmulpsq(&c[i - 1], a[sc], &carry);
X		}
X		uncar += carry;
X		carry = uncar >> NBITS;
X		c[i] = uncar & RADIXM;
X	}
X	while ((i > 1) && (!(c[i])))
X		i--;
X	c[0] = i;
X}
X
Xvoid
Xzsqin(
X	verylong *a
X	)
X{
X	static verylong mem = 0;
X
X	if (ALLOCATE && !*a)
X	{
X		zzero(a);
X		return;
X	}
X	zcopy(*a, &mem);
X	zsq(mem, a);
X}
X
Xlong 
Xzsdiv(
X	verylong a,
X	long d,
X	verylong *bb
X	)
X{
X	register long sa;
X	verylong b = *bb;
X
X#ifndef START
X	if (fudge < 0)
X		zstart();
X#endif
X	if (ALLOCATE && !a)
X	{
X		zzero(bb);
X		return (0);
X	}
X	if (!d)
X        {
X		zhalt("division by zero in zsdiv");
X		return (0);
X	}
X	if ((sa = a[0]) < 0)
X		sa = (-sa);
X	zsetlength(&b, sa, "in zsdiv, third argument");
X	if (a == *bb) a = b;
X	*bb = b;
X	if ((d >= RADIX) || (d <= -RADIX))
X	{
X		static verylong zd = 0;
X		static verylong zb = 0;
X
X		zintoz(d, &zb);
X		zdiv(a, zb, &b, &zd);
X		*bb = b;
X		return (ztoint(zd));
X	}
X	else
X	{
X		register long den = d;
X		register double deninv;
X		register long carry = 0;
X		register long i;
X		long flag = (*a < 0 ? 2 : 0) | (den < 0 ? 1 : 0);
X
X		if (den < 0)
X			den = -den;
X		deninv = (double)1/den;
X		if (a[sa] < den && sa > 1)
X			carry = a[sa--];
X		for (i = sa; i; i--)
X		{
X			zdiv21(carry, a[i], den, deninv, b[i]);
X		}
X		while ((sa > 1) && (!(b[sa])))
X			sa--;
X		b[0] = sa;
X		if (flag)
X		{
X			if (flag <= 2)
X			{
X				if (!carry)
X					znegate(&b);
X				else
X				{
X					zadd(b, one, &b);
X					b[0] = -b[0];
X					if (flag == 1)
X						carry = carry - den;
X					else
X						carry = den - carry;
X					*bb = b;
X				}
X			}
X			else
X				carry = -carry;
X		}
X		return (carry);
X	}
X}
X
Xlong 
Xzsmod(
X	verylong a,
X	long b
X	)
X{
X	static verylong q = 0;
X
X	return (zsdiv(a, b, &q));
X}
X
Xvoid
Xzdiv(
X	verylong in_a,
X	verylong in_b,
X	verylong *qqq,
X	verylong *rrr
X	)
X{
X	register long i;
X	register long qq;
X	long sa;
X	long sb;
X	long sq;
X	verylong p;
X	verylong pc;
X	long sign;
X	static verylong a = 0;
X	static verylong b = 0;
X	static verylong c = 0;
X	static verylong d = 0;
X	double btopinv;
X	double aux;
X	verylong q = *qqq;
X	verylong r = *rrr;
X
X#ifndef START
X	if (fudge < 0)
X		zstart();
X#endif
X	if (ALLOCATE && !in_a)
X	{
X		zzero(qqq);
X		zzero(rrr);
X		return;
X	}
X	if ((!in_b) || (((sb = in_b[0]) == 1) && (!in_b[1])))
X	{
X		zhalt("division by zero in zdiv");
X		return;
X	}
X	zcopy(in_a,&a);
X	zcopy(in_b,&b);
X	sign = (*a < 0 ? 2 : 0) | (*b < 0 ? 1 : 0);
X	if (*a < 0)
X		(*a) = (-(*a));
X	sa = (*a);
X	if (*b < 0)
X		(*b) = (-(*b));
X	sb = (*b);
X	zsetlength(&c, (i = (sa > sb ? sa : sb) + 1), "in zdiv, locals\n");
X	zsetlength(&d, i, "");
X	zsetlength(&q, i, "in zdiv, third argument");
X	*qqq = q;
X	zsetlength(&r, sb + 1, "in zdiv, fourth argument");
X	*rrr = r;
X	p = &b[sb];
X	if ((sb == 1) && (*p < RADIX))
X		zintoz(zsdiv(a, *p, &q), &r);
X	else
X	{
X		sq = sa - sb;
X		btopinv = (double) (*p) * fradix;
X		if (sb > 1)
X			btopinv += (*(--p));
X		btopinv *= fradix;
X		if (sb > 2)
X			btopinv += (*(p - 1));
X		btopinv = fudge / btopinv;
X		p = &a[1];
X		pc = &c[0];
X		for (i = sa; i > 0; i--)
X			*pc++ = *p++;
X		p = pc;
X		sa = 1 - sb;
X		for (i = (-sq); i > 0; i--)
X			*p++ = 0;
X		*pc = 0;
X		d[1] = 0;
X		p = &d[sq + 1];
X		for (i = sq; i >= 0; i--)
X		{
X			aux = fradix * (fradix * (*pc) + (*(pc - 1))) + 1.0;
X			if (i > sa)
X				aux += (*(pc - 2));
X			qq = (long) (btopinv * aux + 0.5);
X		/* dirty, but safe. On most machines (long)(btopinv*aux) */
X		/* is correct, or one too big; on some however it becomes */
X		/* too small. Could change zstart, but +0.5 and a while */
X		/* instead of one single if is safer */
X			if (qq > 0)
X			{
X				zsubmul(qq, &c[i], &b[0]);
X				while (*pc < 0)
X				{
X					qq--;
X					{
X						zaddmulone(&c[i], &b[0]);
X					}
X				}
X			}
X			pc--;
X			*p-- = qq;
X		}
X		sb--;
X		while ((sb > 0) && (!(c[sb])))
X			sb--;
X		sb++;
X		r[0] = sb;
X		p = &r[1];
X		pc = &c[0];
X		for (i = sb; i > 0; i--)
X			*p++ = *pc++;
X		if (sq < 0)
X		{
X			q[0] = 1;
X			q[1] = d[1];
X		}
X		else
X		{
X			sq++;
X			while ((sq > 1) && (!(d[sq])))
X				sq--;
X			q[0] = sq;
X			p = &q[1];
X			pc = &d[1];
X			for (i = sq; i > 0; i--)
X				*p++ = *pc++;
X		}
X	}	/* non-trivial case */
X
X	if (sign)
X	{
X		if (sign <= 2)
X		{
X			if (!(r[1]) && (r[0] == 1))
X				q[0] = -(q[0]);
X			else
X			{
X				zadd(q, one, &q);
X				q[0] = -q[0];
X				if (sign == 1)
X					zsub(r, b, &r);
X				else
X					zsub(b, r, &r);
X			}
X		}
X		else
X			znegate(&r);
X	}
X	*qqq = q;
X	*rrr = r;
X}
X
Xvoid
Xzmod(
X	verylong in_a,
X	verylong in_b,
X	verylong *rr
X	)
X{
X	register long i;
X	register long qq;
X	verylong r = *rr;
X	static verylong a = 0;
X	static verylong b = 0;
X	static verylong c = 0;
X	long sa;
X	long sb;
X	long sq;
X	verylong p;
X	verylong pc;
X	long sign;
X	double btopinv;
X	double aux;
X
X#ifndef START
X	if (fudge < 0)
X		zstart();
X#endif
X	if (ALLOCATE && !in_a)
X	{
X		zzero(rr);
X		return;
X	}
X	if ((!in_b) || (((sb = in_b[0]) == 1) && (!in_b[1])))
X	{
X		zhalt("division by zero in zmod");
X		return;
X	}
X	zcopy(in_a,&a);
X	zcopy(in_b,&b);
X	sign = (*a < 0 ? 2 : 0) | (*b < 0 ? 1 : 0);
X	if (*a < 0)
X		(*a) = (-(*a));
X	sa = (*a);
X	if (*b < 0)
X		(*b) = (-(*b));
X	sb = (*b);
X	zsetlength(&c, (sa > sb ? sa : sb) + 1, "in zmod, local");
X	zsetlength(&r, sb + 1, "in zmod, third argument");
X	*rr = r;
X	p = &b[sb];
X	if ((sb == 1) && (*p < RADIX))
X		zintoz(zsdiv(a, *p, &c), &r);
X	else
X	{
X		sq = sa - sb;
X		btopinv = (double) (*p) * fradix;
X		if (sb > 1)
X			btopinv += (*(--p));
X		btopinv *= fradix;
X		if (sb > 2)
X			btopinv += (*(p - 1));
X		btopinv = fudge / btopinv;
X		p = &a[1];
X		pc = &c[0];
X		for (i = sa; i > 0; i--)
X			*pc++ = *p++;
X		p = pc;
X		sa = 1 - sb;
X		for (i = (-sq); i > 0; i--)
X			*p++ = 0;
X		*pc = 0;
X		for (i = sq; i >= 0; i--)
X		{
X			aux = fradix * (fradix * (*pc) + (*(pc - 1))) + 1.0;
X			if (i > sa)
X				aux += (*(pc - 2));
X			qq = (long) (btopinv * aux + 0.5);
X		/* see comment in zdiv */
X			if (qq > 0)
X			{
X				zsubmul(qq, &c[i], &b[0]);
X				while (*pc < 0)
X				{
X					{
X						zaddmulone(&c[i], &b[0]);
X					}
X				}
X			}
X			pc--;
X		}	/* loop on i */
X		sb--;
X		while ((sb > 0) && (!(c[sb])))
X			sb--;
X		sb++;
X		r[0] = sb;
X		p = &r[1];
X		pc = &c[0];
X		for (i = sb; i > 0; i--)
X			*p++ = *pc++;
X	}	/* non-trivial case */
X	if (sign)
X	{
X		if ((sign <= 2) && (!((r[0] == 1) && !(r[1]))))
X		{
X			if (sign == 1)
X				zsub(r, b, &r);
X			else
X				zsub(b, r, &r);
X		}
X		else
X			znegate(&r);	/* negating r==0 doesn't hurt */
X	}
X	*rr = r;
X}
X
Xvoid
Xzaddmod(
X	verylong a,
X	verylong b,
X	verylong n,
X	verylong *c
X	)
X{
X	if (ALLOCATE && !n)
X	{
X		zhalt("modulus zero in zaddmod");
X		return;
X	}
X	if (ALLOCATE && !a)
X	{
X		if (b)
X			zcopy(b, c);
X		else
X			zzero(c);
X		return;
X	}
X	if (ALLOCATE && !b)
X	{
X		zcopy(a, c);
X		return;
X	}
X	zadd(a, b, c);
X	if (zcompare(*c, n) >= 0)
X		zsubpos(*c, n, c);
X}
X
Xvoid
Xzsubmod(
X	verylong a,
X	verylong b,
X	verylong n,
X	verylong *c
X	)
X{
X	if (ALLOCATE && !n)
X	{
X		zhalt("modulus zero in zsubmod");
X		return;
X	}
X	if (ALLOCATE && !b)
X	{
X		if (a)
X			zcopy(a, c);
X		else
X			zzero(c);
X		return;
X	}
X	if (ALLOCATE && !a)
X	{
X		if (b[1] || (b[0] != 1))
X			zsubpos(n, b, c);
X		else
X			zzero(c);
X		return;
X	}
X	zsub(a, b, c);
X	if ((*c)[0] < 0)
X		zadd(*c, n, c);
X}
X
Xvoid
Xzsmulmod(
X	verylong a,
X	long d,
X	verylong n,
X	verylong *c
X	)
X{
X	static verylong mem = 0;
X
X	if (ALLOCATE && !n)
X	{
X		zhalt("modulus zero in zsmulmod");
X		return;
X	}
X	if (ALLOCATE && (!a || !d))
X	{
X		zzero(c);
X		return;
X	}
X	zsetlength(&mem, a[0] + 3, "in zsmulmod, local");
X	zsmul(a, d, &mem);
X	zmod(mem, n, c);
X}
X
Xvoid
Xzmulmod(
X	verylong a,
X	verylong b,
X	verylong n,
X	verylong *c
X	)
X{
X	static verylong mem = 0;
X
X	if (ALLOCATE && !n)
X	{
X		zhalt("modulus zero in zmulmod");
X		return;
X	}
X	if (ALLOCATE && (!a || !b))
X	{
X		zzero(c);
X		return;
X	}
X	zsetlength(&mem, a[0] + b[0] + 2, "in zmulmod, local");
X	zmul(a, b, &mem);
X	zmod(mem, n, c);
X}
X
Xvoid
Xzsqmod(
X	verylong a,
X	verylong n,
X	verylong *c
X	)
X{
X	static verylong mem = 0;
X
X	if (ALLOCATE && !n)
X	{
X		zhalt("modulus zero in zsqmod");
X		return;
X	}
X	if (ALLOCATE && !a)
X	{
X		zzero(c);
X		return;
X	}
X	zsetlength(&mem, 2 * a[0] + 2, "in zsqmod, local");
X	zsq(a, &mem);
X	zmod(mem, n, c);
X}
X
Xvoid
Xzdivmod(
X	verylong a,
X	verylong b,
X	verylong n,
X	verylong *c
X	)
X{
X	static verylong g = 0;
X	static verylong na = 0;
X	static verylong nb = 0;
X	static verylong r = 0;
X
X	if (ALLOCATE && !n)
X	{
X		zhalt("modulus zero in zdivmod");
X		return;
X	}
X	if (ALLOCATE && !a)
X	{
X		zzero(c);
X		return;
X	}
X	if (ALLOCATE && !b)
X	{
X		zhalt("divisor zero in zdivmod");
X		return;
X	}
X	zgcd(a, b, &g);
X	if ((g[1] == 1) && (g[0] == 1))
X	{
X		if (zinv(b, n, &g))
X		{
X			zhalt("undefined quotient in zdivmod");
X			zcopy(g,c);
X		}
X		else
X			zmulmod(a, g, n, c);
X	}
X	else
X	{
X		zdiv(a, g, &na, &r);
X		zdiv(b, g, &nb, &r);
X		if (zinv(nb, n, &g))
X		{
X			zhalt("undefined quotient in zdivmod");
X                        zcopy(g,c);
X                }
X		else
X			zmulmod(na, g, n, c);
X	}
X}
X
Xvoid
Xzinvmod(
X	verylong a,
X	verylong n,
X	verylong *c
X	)
X{
X	if (ALLOCATE && !n)
X	{
X		zhalt("modulus zero in zinvmod");
X		return;
X	}
X	if (ALLOCATE && !a)
X	{
X		zhalt("division by zero in zinvmod");
X		return;
X	}
X	if (zinv(a, n, c))
X		zhalt("undefined inverse in zinvmod");
X}
X
Xstatic void
Xzmstartint(
X	verylong n
X	)
X{
X	static verylong x = 0;
X	long i;
X
X	if (!n || !(n[1] & 1) || ((zntop = n[0]) < 1)
X			|| ((zntop == 1) && (n[1] <= 1)))
X	{
X		zhalt("zero, or even, or negative modulus in zmstart");
X		return;
X	}
X	if (n[zntop] >= (RADIX >> 1))
X		zntop++;
X	zsetlength(&x, (long) (zntop + 1), "in zmstart, local");
X	zsetlength(&zn, (long) (zntop + 1), "in zmstart, globals\n");
X	zsetlength(&zr, (long) (zntop + 1), "");
X	zsetlength(&zrr, (long) (zntop + 1), "");
X	zsetlength(&zrrr, (long) (zntop + 1), "");
X	zsetlength(&znm, (long) (zntop + 1), "");
X	if (zcompare(n, zn))
X	{
X		zcopy(n, &zn);
X		zadd(zn, one, &zrr);
X		zrshift(zrr, (long) 1, &x);	/* x = (n+1)/2 */
X		zrr[0] = 1;
X		zrr[1] = NBITS;
X		zexpmod(x, zrr, zn, &x);	/* x = 2^(-NBITS) %n    */
X		for (i = x[0]; i; i--)
X			x[i + 1] = x[i];
X		x[1] = 0;
X		x[0]++;
X		zsubpos(x, one, &x);
X		zdiv(x, zn, &x, &zrr);
X		zminv1 = x[1];	/* zminv1 = n[1]^(-1) modulo 2^NBITS */
X		zminv2 = zminv1 >> NBITSH;
X		zminv1 &= RADIXROOTM;
X		for (i = 1; i <= zntop; i++)
X			x[i] = 0;
X		x[zntop + 1] = 1;
X		x[0] = zntop + 1;
X		zdiv(x, zn, &zrr, &zr);
X		zsqmod(zr, zn, &zrr);
X		zmulmod(zr, zrr, zn, &zrrr);
X		zsubmod(zn, zr, zn, &znm);
X	}
X}
X
Xstatic void
Xzmkeep(
X	verylong n
X	)
X{
X	if (znotinternal)
X		zcopy(zn, &zoldzn);
X	zmstartint(n);
X}
X
Xstatic void
Xzmback(
X	)
X{
X	if (znotinternal)
X		zmstartint(zoldzn);
X}
X
Xvoid
Xzmstart(
X	verylong n
X	)
X{
X	zmstartint(n);
X	znotinternal = 1;
X}
Xvoid
Xzmfree(
X	)
X{
X	znotinternal = 0;
X}
X
Xvoid
Xztom(
X	verylong a,
X	verylong *bb
X	)
X{
X	if (!zn)
X	{
X		zhalt("undefined Montgomery modulus in ztom");
X		return;
X	}
X	if (ALLOCATE && !a)
X	{
X		zzero(bb);
X		return;
X	}
X	if (zcompare(zn, a) < 0)
X	{
X		zmod(a, zn, bb);
X		zmontmul(*bb, zrr, bb);
X	}
X	else
X		zmontmul(a, zrr, bb);
X}
X
Xvoid
Xzmtoz(
X	verylong a,
X	verylong *bb
X	)
X{
X	if (!zn)
X	{
X		zhalt("undefined Montgomery modulus in zmtoz");
X		return;
X	}
X	if (ALLOCATE && !a)
X	{
X		zzero(bb);
X		return;
X	}
X	zmontmul(a, one, bb);
X}
X
Xvoid
Xzmontadd(
X	verylong a,
X	verylong b,
X	verylong *c
X	)
X{
X	if (!zn)
X	{
X		zhalt("undefined Montgomery modulus in zmontadd");
X		return;
X	}
X	zaddmod(a, b, zn, c);
X}
X
Xvoid
Xzmontsub(
X	verylong a,
X	verylong b,
X	verylong *c
X	)
X{
X	if (!zn)
X	{
X		zhalt("undefined Montgomery modulus in zmontsub");
X		return;
X	}
X	zsubmod(a, b, zn, c);
X}
X
Xvoid
Xzsmontmul(
X	verylong a,
X	long d,
X	verylong *c
X	)
X{
X	if (!zn)
X	{
X		zhalt("undefined Montgomery modulus in zsmontmul");
X		return;
X	}
X	zsmulmod(a, d, zn, c);
X}
X
Xvoid
Xzmontmul(
X	verylong a,
X	verylong b,
X	verylong *cc
X	)
X{
X	register long i;
X	register long j;
X	verylong c = *cc;
X	static verylong x = 0;
X	verylong px;
X	verylong pc;
X
X	if (!zn)
X	{
X		zhalt("undefined Montgomery modulus in zmontmul");
X		return;
X	}
X	if (ALLOCATE && (!a || !b))
X	{
X		zzero(cc);
X		return;
X	}
X	zsetlength(&x, (i = (zntop << 1) + 1), "in zmontmul, local");
X	zsetlength(&c, zntop, "in zmontmul, third argument");
X	if (a == *cc) a = c;
X	if (b == *cc) b = c;
X	*cc = c;
X        if (!kar_mem_initialized)
X        {
X                kar_mem_initialized = 1;
X                for (j = (5 * MAXDEPTH) - 1; j >= 0; j--)
X                        kar_mem[j] = (verylong) 0;
X        }
X	if (*a <= *b)
X		kar_mul(b, a, &x, (long) 0);
X	else
X		kar_mul(a, b, &x, (long) 0);
X	for (; i > x[0]; i--)
X		x[i] = (long) 0;
X	px = &x[1];
X	for (i = zntop; i > 0; i--)
X		zmmulp(px++, zn);
X	pc = &c[1];
X	for (i = zntop; i > 0; i--)
X		*pc++ = *px++;
X	i = zntop;
X	while ((i > 1) && (!(*--pc)))
X		i--;
X	c[0] = i;
X	if (zcompare(c, zn) >= 0)
X		zsubpos(c, zn, &c);
X	*cc = c;
X}
X
Xvoid
Xzmontsq(
X	verylong a,
X	verylong *cc
X	)
X{
X	register long i;
X	register long j;
X	verylong c = *cc;
X	static verylong x = 0;
X	verylong px;
X	verylong pc;
X
X	if (!zn)
X	{
X		zhalt("undefined Montgomery modulus in zmontsq");
X		return;
X	}
X	if (ALLOCATE && !a)
X	{
X		zzero(cc);
X		return;
X	}
X	zsetlength(&x, (i = (zntop << 1) + 1), "in zmontsq, local");
X	zsetlength(&c, zntop, "in zmontsq, third argument");
X	if (a == *cc) a = c;
X	*cc = c;
X        if (!kar_mem_initialized)
X        {
X                kar_mem_initialized = 1;
X                for (j = (5 * MAXDEPTH) - 1; j >= 0; j--)
X                        kar_mem[j] = (verylong) 0;
X        }
X	kar_sq(a, &x, (long) 0);
X	for (; i > x[0]; i--)
X		x[i] = (long) 0;
X	px = &x[1];
X	for (i = zntop; i > 0; i--)
X		zmmulp(px++, zn);
X	pc = &c[1];
X	for (i = zntop; i > 0; i--)
X		*pc++ = *px++;
X	i = zntop;
X	while ((i > 1) && (!(*--pc)))
X		i--;
X	c[0] = i;
X	if (zcompare(c, zn) >= 0)
X		zsubpos(c, zn, &c);
X	*cc = c;
X}
X
Xvoid
Xzmontdiv(
X	verylong a,
X	verylong b,
X	verylong *c
X	)
X{
X	static verylong g = 0;
X	static verylong na = 0;
X	static verylong nb = 0;
X	static verylong r = 0;
X
X	if (!zn)
X	{
X		zhalt("undefined Montgomery modulus in zmontdiv");
X		return;
X	}
X	if (ALLOCATE && !a)
X	{
X		zzero(c);
X		return;
X	}
X	if (ALLOCATE && !b)
X	{
X		zhalt("division by zero in zmontdiv");
X		return;
X	}
X	zgcd(a, b, &g);
X	if ((g[1] == 1) && (g[0] == 1))
X	{
X		if (zinv(b, zn, &g))
X		{
X			zhalt("undefined quotient in zmontdiv");
X			zcopy(g,c);
X			return;
X		}
X		else
X			zmontmul(g, a, &g);
X	}
X	else
X	{
X		zdiv(a, g, &na, &r);
X		zdiv(b, g, &nb, &r);
X		if (zinv(nb, zn, &g))
X		{
X			zhalt("undefined quotient in zmontdiv");
X			zcopy(g,c);
X                        return;
X		}
X		else
X			zmontmul(g, na, &g);
X	}
X	zmontmul(g, zrrr, c);
X}
X
Xvoid
Xzmontinv(
X	verylong a,
X	verylong *c
X	)
X{
X	if (!zn)
X	{
X		zhalt("undefined Montgomery modulus in zmontinv");
X		return;
X	}
X        if (ALLOCATE && !a)
X	{
X                zhalt("division by zero in zmontinv");
X		return;
X	}
X	if (zinv(a, zn, c))
X	{
X		zhalt("undefined inverse in zmontinv");
X		return;
X	}
X	zmontmul(*c, zrrr, c);
X}
X
X
Xvoid
Xzrstarts(
X	long s
X	)
X{
X	register long i;
X	register long ones;
X	register long res;
X	static verylong three = 0;
X
X	zintoz(s, &zseed);
X	if (!three)
X	{
X		zintoz((long) 3, &three);
X		ones = 107 / NBITS;
X		res = 107 % NBITS;
X		zsetlength(&zranp, ones + 1, "in zrstarts, zranp");
X		for (i = ones; i; i--)
X			zranp[i] = RADIXM;
X		if (res)
X			zranp[++ones] = (RADIXM >> (NBITS - res));
X		zranp[0] = ones;
X	}
X	zsexpmod(three, (long) 121, zranp, &zprroot);
X}
X
Xvoid
Xzrstart(
X	verylong s
X	)
X{
X	if (!zseed)
X		zrstarts((long) 7157891);
X	zmod(s, zranp, &zseed);
X}
X
Xlong 
Xzrandom(
X	long b
X	)
X{
X	static verylong zb = 0;
X	static verylong bound = 0;
X
X	if (b <= 0)
X		return (0);
X	if (!zseed)
X		zrstarts((long) 7157891);	/* guess how random 7157891
X						 * is */
X	zintoz(b, &zb);
X	zmod(zranp, zb, &bound);
X	zsubpos(zranp, bound, &bound);
X	do
X	{
X		zmulmod(zseed, zprroot, zranp, &zseed);
X	} while (zcompare(zseed, bound) >= 0);	/* I agree, this is sick */
X	zmod(zseed, zb, &zb);
X	return (ztoint(zb));
X}
X
Xlong 
Xzinvodds(
X	long n,
X	long p
X	)
X{
X	register long n1 = n;
X	register long n2 = p;
X	register long preg = p;
X	register long m1 = 1;
X	register long m2 = 0;
X
X /* m1*n == n1 mod p,  m2*n == n2 mod p */
X /* n2 is odd, n1 is odd after initialization */
X	while (!(n1 & 1))
X	{
X		n1 >>= 1;
X		if (m1 & 1)
X			m1 += preg;
X		m1 >>= 1;
X	}
X	if (n1 == 1)
X		return (m1);
X	while (n1 != n2)
X	{
X		if (n1 > n2)
X		{
X			n1 -= n2;
X			m1 -= m2;
X			if (m1 < 0)
X				m1 += preg;
X			do
X			{
X				n1 >>= 1;
X				if (m1 & 1)
X					m1 += preg;
X				m1 >>= 1;
X			} while (!(n1 & 1));
X			if (n1 == 1)
X				return (m1);
X		}
X		else
X		{
X			n2 -= n1;
X			m2 -= m1;
X			if (m2 < 0)
X				m2 += preg;
X			do
X			{
X				n2 >>= 1;
X				if (m2 & 1)
X					m2 += preg;
X				m2 >>= 1;
X			} while (!(n2 & 1));
X			if (n2 == 1)
X				return (m2);
X		}
X	}
X	zhalt("arguments not coprime in zinvodds");
X	return (0);
X}
X
Xlong 
Xzinvs(
X	long n,
X	long p
X	)
X{
X	register long q = n;
X	register long r;
X	register long nq;
X	register long nr;
X	register long u = 1;
X	register long w;
X	register long nw;
X	register long par = 0;
X
X	if (p < 0)
X		p = -p;
X	if (n < 0)
X		n = -n;
X	if (n > p)
X	{
X		w = 0;
X		r = p;
X	}
X	else
X		r = p - (w = p / n) * n;
X	nr = r;
X	while (nr != 0)
X	{
X		if ((nr = q - r) < r)
X			nq = 1;
X		else if ((nr -= r) < r)
X			nq = 2;
X		else
X			nr = q - (nq = q / r) * r;
X		nw = nq * w + u;
X		u = w;
X		w = nw;
X		q = r;
X		r = nr;
X		par = 1 - par;
X	}
X	if (par == 0)
X		return (u);
X	else
X		return (p - u);
X}
X
Xstatic long 
Xzxxeucl(
X	verylong ain,
X	verylong nin,
X	verylong *invv,
X	verylong *uu
X	)
X{
X	static verylong a = 0;
X	static verylong n = 0;
X	static verylong q = 0;
X	static verylong w = 0;
X	static verylong x = 0;
X	static verylong y = 0;
X	static verylong z = 0;
X	verylong inv = *invv;
X	verylong u = *uu;
X	long diff;
X	long ilo;
X	long sa;
X	long sn;
X	long temp;
X	long e;
X	long fast;
X	long parity;
X	long gotthem;
X	verylong pin;
X	verylong p;
X	long i;
X	long try11;
X	long try12;
X	long try21;
X	long try22;
X	long got11;
X	long got12;
X	long got21;
X	long got22;
X	double hi;
X	double lo;
X	double dt;
X	double fhi;
X	double flo;
X	double num;
X	double den;
X	double dirt;
X
X#ifndef START
X	if (fudge < 0)
X		zstart();
X#endif
X	zsetlength(&a, (e = (ain[-1] > nin[-1] ? ain[-1] : nin[-1])), 
X	           "in zxxeucl, locals\n");
X	zsetlength(&n, e, "");
X	zsetlength(&q, e, "");
X	zsetlength(&w, e, "");
X	zsetlength(&x, e, "");
X	zsetlength(&y, e, "");
X	zsetlength(&z, e, "");
X	zsetlength(&inv, e, "in zxxeucl, third argument");
X	*invv = inv;
X	zsetlength(&u, e, "in zxxeucl, fourth argument");
X	*uu = u;
X	fhi = 1.0 + epsilon;
X	flo = 1.0 - epsilon;
X	pin = &ain[0];
X	p = &a[0];
X	for (i = (*pin); i >= 0; i--)
X		*p++ = *pin++;
X	pin = &nin[0];
X	p = &n[0];
X	for (i = (*pin); i >= 0; i--)
X		*p++ = *pin++;
X	inv[0] = 1;
X	inv[1] = 1;
X	w[0] = 1;
X	w[1] = 0;
X	while (n[0] > 1 || n[1] > 0)
X	{
X		gotthem = 0;
X		sa = a[0];
X		sn = n[0];
X		diff = sa - sn;
X		if (!diff || diff == 1)
X		{
X			sa = a[0];
X			p = &a[sa];
X			num = (double) (*p) * fradix;
X			if (sa > 1)
X				num += (*(--p));
X			num *= fradix;
X			if (sa > 2)
X				num += (*(p - 1));
X			sn = n[0];
X			p = &n[sn];
X			den = (double) (*p) * fradix;
X			if (sn > 1)
X				den += (*(--p));
X			den *= fradix;
X			if (sn > 2)
X				den += (*(p - 1));
X			hi = fhi * (num + 1.0) / den;
X			lo = flo * num / (den + 1.0);
X			if (diff > 0)
X			{
X				hi *= fradix;
X				lo *= fradix;
X			}
X			try11 = 1;
X			try12 = 0;
X			try21 = 0;
X			try22 = 1;
X			parity = 1;
X			fast = 1;
X			while (fast > 0)
X			{
X				parity = 1 - parity;
X				if (hi >= fradix)
X					fast = 0;
X				else
X				{
X					ilo = (long)lo;
X					dirt = hi - ilo;
X					if (!dirt || !ilo || ilo < (long)hi)
X						fast = 0;
X					else
X					{
X						dt = lo;
X						lo = flo / dirt;
X						if (dt > ilo)
X							hi = fhi / (dt - ilo);
X						else
X							hi = fradix;
X						temp = try11;
X						try11 = try21;
X						if ((RADIX - temp) / ilo < try21)
X							fast = 0;
X						else
X							try21 = temp + ilo * try21;
X						temp = try12;
X						try12 = try22;
X						if ((RADIX - temp) / ilo < try22)
X							fast = 0;
X						else
X							try22 = temp + ilo * try22;
X						if ((fast > 0) && (parity > 0))
X						{
X							gotthem = 1;
X							got11 = try11;
X							got12 = try12;
X							got21 = try21;
X							got22 = try22;
X						}
X					}
X				}
X			}
X		}
X		if (gotthem)
X		{
X			zsmul(inv, got11, &x);
X			zsmul(w, got12, &y);
X			zsmul(inv, got21, &z);
X			zsmul(w, got22, &w);
X			zadd(x, y, &inv);
X			zadd(z, w, &w);
X			zsmul(a, got11, &x);
X			zsmul(n, got12, &y);
X			zsmul(a, got21, &z);
X			zsmul(n, got22, &n);
X			zsub(x, y, &a);
X			zsub(n, z, &n);
X		}
X		else
X		{
X			zdiv(a, n, &q, &a);
X			zmul(q, w, &x);
X			zadd(inv, x, &inv);
X			if (a[0] > 1 || a[1] > 0)
X			{
X				zdiv(n, a, &q, &n);
X				zmul(q, inv, &x);
X				zadd(w, x, &w);
X			}
X			else
X			{
X				p = &a[0];
X				pin = &n[0];
X				for (i = (*pin); i >= 0; i--)
X					*p++ = *pin++;
X				n[0] = 1;
X				n[1] = 0;
X				zsub(nin, w, &inv);
X			}
X		}
X	}
X	if ((a[0] == 1) && (a[1] == 1))
X		e = 0;
X	else
X		e = 1;
X	p = &u[0];
X	pin = &a[0];
X	for (i = (*pin); i >= 0; i--)
X		*p++ = *pin++;
X	*invv = inv;
X	*uu = u;
X	return (e);
X}
X
Xlong 
Xzinv(
X	verylong ain,
X	verylong nin,
X	verylong *invv
X	)
X{
X	static verylong u = 0;
X
X	if ((!nin) || (!ain) || (ain[0] < 0) || (nin[0] < 0))
X	{
X		zhalt("zero or negative argument(s) in zinv");
X		return (0);
X	}
X	if (!(zxxeucl(ain, nin, invv, &u)))
X		return (0);
X	zcopy(u, invv);
X	return (1);
X}
X
Xvoid
Xzexteucl(
X	verylong a,
X	verylong *xa,
X	verylong b,
X	verylong *xb,
X	verylong *d
X	)
X{
X	static verylong modcon = 0;
X	register long agrb;
X	register long anegative = 0;
X	register long bnegative = 0;
X
X	if ((!a) || (!b))
X	{
X		zhalt("zero argument(s) in zexteucl");
X		return;
X	}
X	if (anegative = (a[0] < 0))
X		a[0] = -a[0];
X	if (bnegative = (b[0] < 0))
X		b[0] = -b[0];
X	if (!a[1] && (a[0] == 1))
X	{
X		zzero(xa);
X		zone(xb);
X		zcopy(b, d);
X		goto done;
X	}
X	if ((!b[1] && (b[0] == 1)) || !(agrb = zcompare(a, b)))
X	{
X		zone(xa);
X		zzero(xb);
X		zcopy(a, d);
X		goto done;
X	}
X	if (agrb > 0)
X	{
X		zxxeucl(a, b, xa, d);
X		zmul(a, *xa, xb);
X		zsub(*d, *xb, xb);
X		zdiv(*xb, b, xb, &modcon);
X	}
X	else
X	{
X		zxxeucl(b, a, xb, d);
X		zmul(b, *xb, xa);
X		zsub(*d, *xa, xa);
X		zdiv(*xa, a, xa, &modcon);
X	}
X	if ((modcon[1]) || (modcon[0] != 1))
X	{
X		zhalt("non-zero remainder in zexteucl   BUG");
X		return;
X	}
Xdone:
X	if (anegative)
X	{
X		a[0] = -a[0];
X		znegate(xa);
X	}
X	if (bnegative)
X	{
X		b[0] = -b[0];
X		znegate(xb);
X	}
X}
X
Xvoid
Xzchirem(
X	verylong aa,
X	verylong maa,
X	verylong bb,
X	verylong mbb,
X	verylong *d
X	)
X{
X	static verylong u = 0;
X	static verylong v = 0;
X	static verylong w = 0;
X	verylong a;
X	verylong b;
X	verylong ma;
X	verylong mb;
X	register long agrb;
X
X	if ((!aa) || (!maa) || (!bb) || (!mbb))
X	{
X		zhalt("zero argument(s) in zchirem");
X		return;
X	}
X	if ((!aa[1] && aa[0] == 1) || (!bb[1] && bb[0] == 1) ||
X			(aa[0] < 0) || (bb[0] < 0))
X	{
X		zhalt("zero or negative argument(s) in zchirem");
Xreturn;
X        }
X	if ((agrb = aa[0]) < bb[0])
X		agrb = bb[0];
X	zsetlength(&u, agrb, "in zchirem, locals");
X	zsetlength(&v, agrb, "");
X	zsetlength(&w, agrb, "");
X	if (!(agrb = zcompare(aa, bb)))
X	{
X		zsub(maa, mbb, &u);
X		zmod(u, aa, &w);
X		if (w[1] || w[0] != 1)
X		{
X			zhalt("same moduli with different remainders in zchirem");
X			return;
X		}
X		zcopy(maa, d);
X		return;
X	}
X	else if (agrb > 0)
X	{
X		a = aa;
X		b = bb;
X		ma = maa;
X		mb = mbb;
X	}
X	else
X	{
X		a = bb;
X		b = aa;
X		ma = mbb;
X		mb = maa;
X	}
X	if (zxxeucl(a, b, &u, &w))
X	{
X		zhalt("moduli not coprime in zchirem");
X		return;
X	}
X	zmod(ma, a, &v);
X	zsub(mb, v, &w);
X	zmulmod(w, u, b, &w);
X	zmul(w, a, &u);
X	zadd(v, u, d);
X}
X
Xvoid
Xzmontexp(
X	verylong a,
X	verylong e,
X	verylong *bb
X	)
X{
X	register long i;
X	register long j;
X	register long k = 0;
X	verylong b = *bb;
X	static verylong loca = 0;
X
X	if (!zn)
X	{
X		zhalt("undefined Montgomery modulus in zmontexp");
X		return;
X	}
X	if (ALLOCATE && !e)
X	{
X		zcopy(zr,bb);
X		return;
X	}
X	if (ALLOCATE && !a)
X	{
X		zzero(bb);
X		return;
X	}
X	if ((i = e[0]) < 0)
X		i = (-i);
X	if ((i == 1) && (!(e[1])))
X		zcopy(zr,&b);
X	else
X	{
X		zcopy(a, &loca);
X		zcopy(loca, &b);
X		for (; i; i--)
X		{
X			j = e[i];
X			if (!k)
X			{
X				k = 1;
X				while ((k << 1) <= j)
X					k <<= 1;
X			}
X			while (k >>= 1)
X			{
X				zmontsq(b, &b);
X				if (j & k)
X					zmontmul(loca, b, &b);
X			}
X			k = RADIX;
X		}
X	}
X	if (e[0] < 0)
X	{
X		if (zinv(b, zn, &b))
X		{
X			zhalt("undefined quotient in zmontexp");
X			return;
X		}
X		zmontmul(b, zrrr, &b);
X	}
X	*bb = b;
X}
X
Xvoid
Xzsexpmod(
X	verylong a,
X	long e,
X	verylong n,
X	verylong *bb
X	)
X{
X	static verylong le = 0;
X
X	zintoz(e, &le);
X	zexpmod(a, le, n, bb);
X}
X
Xvoid
Xzexpmod(
X	verylong a,
X	verylong e,
X	verylong n,
X	verylong *bb
X	)
X{
X	register long i;
X	register long j;
X	register long k = 0;
X	verylong b = *bb;
X	static verylong loca = 0;
X
X	if (ALLOCATE && !n)
X	{
X		zhalt("modulus zero in zexpmod");
X		return;
X	}
X	if (ALLOCATE && !e)
X	{
X		zone(bb);
X		return;
X	}
X	if (ALLOCATE && !a)
X	{
X		zzero(bb);
X		return;
X	}
X	if ((i = e[0]) < 0)
X		i = (-i);
X	if ((i == 1) && (!(e[1])))
X		zone(&b);
X	else
X	{
X		zmod(a, n, &loca);
X		zcopy(loca, &b);
X		for (; i; i--)
X		{
X			j = e[i];
X			if (!k)
X			{
X				k = 1;
X				while ((k << 1) <= j)
X					k <<= 1;
X			}
X			while (k >>= 1)
X			{
X				zsqmod(b, n, &b);
X				if (j & k)
X					zmulmod(loca, b, n, &b);
X			}
X			k = RADIX;
X		}
X	}
X	if (e[0] < 0 && zinv(b, n, &b))
X		zhalt("undefined quotient in zexpmod");
X	*bb = b;
X}
X
Xvoid
Xz2expmod(
X	verylong e,
X	verylong n,
X	verylong *bb
X	)
X{
X	register long i;
X	register long j;
X	register long k = 0;
X	verylong b = *bb;
X
X	if (ALLOCATE && !n)
X	{
X		zhalt("modulus zero in z2expmod");
X		return;
X	}
X	if (ALLOCATE && !e)
X	{
X		zone(bb);
X		return;
X	}
X	if ((i = e[0]) < 0)
X		i = (-i);
X	if ((i == 1) && (!(e[1])))
X		zone(&b);
X	else
X	{
X		if ((j = n[0]) < 0)
X			j = -j;
X		zsetlength(&b, j, "in z2expmod, third argument");
X		*bb = b;
X		zintoz((long) 2, &b);
X		for (; i; i--)
X		{
X			j = e[i];
X			if (!k)
X			{
X				k = 1;
X				while ((k << 1) <= j)
X					k <<= 1;
X			}
X			while (k >>= 1)
X			{
X				zsqmod(b, n, &b);
X				if (j & k)
X				{
X					z2mul(b, &b);
X					if (zcompare(b, n) >= 0)
X						zsubpos(b, n, &b);
X				}
X			}
X			k = RADIX;
X		}
X	}
X	if (e[0] < 0 && zinv(b, n, &b))
X		zhalt("undefined quotient in z2expmod");
X	*bb = b;
X}
X
Xlong 
Xzdefault_m(
X	long l
X	)
X{
X	if (l < 2)
X		return (2);
X	if (l < 3)
X		return (3);
X	if (l < 7)
X		return (4);
X	if (l < 16)
X		return (5);
X	if (l < 35)
X		return (6);
X	if (l < 75)
X		return (7);
X	if (l < 160)
X		return (8);
X	if (l < 340)
X		return (9);
X	return (10);
X}
X
Xstatic void 
Xmont_init_odd_power(
X	verylong a,
X	verylong *a_sq,
X	long m,
X	verylong **odd_a_power
X	)
X{
X /* odd power setter for montgomery m-ary exponentiation */
X /* initialize odd_a_power with a^i mod n for odd positive i < 2^m */
X /* a on input is montgomery number */
X	register long i;
X	register long length = (1 << (m - 1));
X
X	if (!(*odd_a_power))
X	{
X		*odd_a_power = (verylong *)malloc((size_t)(length * sizeof(verylong)));
X		for (i = 0; i < length; i++)
X			(*odd_a_power)[i] = (verylong) 0;
X	}
X	zcopy(a, &((*odd_a_power)[0]));
X	zmontsq((*odd_a_power)[0], a_sq);
X}
X
Xvoid
Xzmontexp_m_ary(
X	verylong a,
X	verylong e,
X	verylong *bb,
X	long m
X	)
X{
X	register long i;
X	register long ei;
X	static verylong a_sq = 0;
X
X	if (!zn)
X	{
X		zhalt("undefined Montgomery modulus in zmontexp_m_ary");
X		return;
X	}
X	if (ALLOCATE && !e)
X	{
X		zcopy(zr,bb);
X		return;
X	}
X	if (ALLOCATE && !a)
X	{
X		zzero(bb);
X		return;
X	}
X	if ((i = e[0]) < 0)
X		i = (-i);
X	if (i == 1)
X	{
X		zmontexp(a, e, bb);
X		return;
X	}
X	if (!exp_odd_powers)
X	{
X		exp_odd_powers = (verylong **)malloc((size_t)(NBITS * sizeof(verylong *)));
X		for (ei = 0; ei < NBITS; ei++)
X			exp_odd_powers[ei] = (verylong *) 0;
X	}
X	if (m <= 1)
X		m = zdefault_m(i);
X	else if (m >= NBITS)
X		m = (NBITS - 1);
X	{
X		register long k = 0;
X		register long od = 0;
X		register long odlen;
X		register long left;
X		register long zeros = 0;
X		register long rem = 0;
X		register long first = 1;
X		register long reach = 1;
X		verylong **loc_pow = &(exp_odd_powers[m]);
X
X		mont_init_odd_power(a, &a_sq, m, loc_pow);
X		for (; i > 0; i--)
X		{
X			ei = e[i];
X			if (!k)
X			{
X				k = 1;
X				while (k <= ei)
X					k <<= 1;
X			}
X			while (k >>= 1)
X			{
X				if (zeros)
X				{
X					if (ei & k)
X					{
X						odlen = od = 1;
X						rem = zeros;
X						left = zeros = 0;
X					}
X					else
X						zeros++;
X				}
X				else if (!od)
X				{
X					if (ei & k)
X					{
X						odlen = od = 1;
X						left = zeros = 0;
X					}
X					else
X						zeros = 1;
X				}
X				else
X				{
X					left++;
X					if (odlen + left == m)
X					{
X						if (ei & k)
X						{
X							od <<= left;
X							odlen += left;
X							left = 0;
X							od++;
X							od >>= 1;
X							for (; reach <= od; reach++)
X								zmontmul((*loc_pow)[reach - 1], a_sq, &((*loc_pow)[reach]));
X							if (first)
X							{
X								zcopy((*loc_pow)[od], bb);
X								first = rem = odlen = od = 0;
X							}
X							else
X							{
X								for (rem = rem + odlen; rem; rem--)
X									zmontsq(*bb, bb);
X								zmontmul(*bb, (*loc_pow)[od], bb);
X								odlen = od = 0;
X							}
X						}
X						else
X						{
X							if (first)
X							{
X								if (od == 1)
X								{
X									zcopy(a_sq, bb);
X									left--;
X								}
X								else
X								{
X									od >>= 1;
X									for (; reach <= od; reach++)
X										zmontmul((*loc_pow)[reach - 1], a_sq, &((*loc_pow)[reach]));
X									zcopy((*loc_pow)[od], bb);
X								}
X								zeros = left;
X								first = left = odlen = od = rem = 0;
X							}
X							else
X							{
X								for (rem = rem + odlen; rem; rem--)
X									zmontsq(*bb, bb);
X								od >>= 1;
X								for (; reach <= od; reach++)
X									zmontmul((*loc_pow)[reach - 1], a_sq, &((*loc_pow)[reach]));
X								zmontmul(*bb, (*loc_pow)[od], bb);
X								zeros = left;
X								left = odlen = od = 0;
X							}
X						}
X					}
X					else if (ei & k)
X					{
X						od <<= left;
X						odlen += left;
X						left = 0;
X						od++;
X					}
X				}
X			}
X			k = RADIX;
X		}
X		if (od)
X		{
X			if (first)
X			{
X				if (od == 1)
X				{
X					zcopy(a_sq, bb);
X					left--;
X				}
X				else
X				{
X					od >>= 1;
X					for (; reach < od; reach++)
X						zmontmul((*loc_pow)[reach - 1], a_sq, &((*loc_pow)[reach]));
X					zmontmul((*loc_pow)[od - 1], a_sq, bb);
X				}
X			}
X			else
X			{
X				for (rem = rem + odlen; rem; rem--)
X					zmontsq(*bb, bb);
X				od >>= 1;
X				for (; reach <= od; reach++)
X					zmontmul((*loc_pow)[reach - 1], a_sq, &((*loc_pow)[reach]));
X				zmontmul(*bb, (*loc_pow)[od], bb);
X			}
X		}
X		if (left || zeros)
X		{
X			for (rem = zeros + left; rem; rem--)
X				zmontsq(*bb, bb);
X		}
X	}
X
X	if (e[0] < 0)
X	{
X		if (zinv(*bb, zn, bb))
X		{
X			zhalt("undefined quotient in zmontexp_m_ary");
X			return;
X		}
X		zmontmul(*bb, zrrr, bb);
X	}
X}
X
Xstatic void 
Xinit_odd_power(
X	verylong a,
X	verylong n,
X	verylong *a_sq,
X	long m,
X	verylong **odd_a_power
X	)
X{
X /* odd power setter for m-ary exponentiation */
X /* initialize odd_a_power with a^i mod n for odd positive i < 2^m */
X /* a on input is not necessarily reduced mod n */
X	register long i;
X	register long length = (1 << (m - 1));
X
X	if (!(*odd_a_power))
X	{
X		*odd_a_power = (verylong *)malloc((size_t)(length * sizeof(verylong)));
X		for (i = 0; i < length; i++)
X			(*odd_a_power)[i] = (verylong) 0;
X	}
X	zmod(a, n, &((*odd_a_power)[0]));
X	zsqmod((*odd_a_power)[0], n, a_sq);
X}
X
Xvoid
Xzexpmod_m_ary(
X	verylong a,
X	verylong e,
X	verylong n,
X	verylong *bb,
X	long m
X	)
X{
X	register long i;
X	register long ei;
X	static verylong a_sq = 0;
X
X	if (ALLOCATE && !n)
X	{
X		zhalt("modulus zero in zexpmod_m_ary");
X		return;
X	}
X	if (ALLOCATE && !e)
X	{
X		zone(bb);
X		return;
X	}
X	if (ALLOCATE && !a)
X	{
X		zzero(bb);
X		return;
X	}
X	if ((i = e[0]) < 0)
X		i = (-i);
X	if (i == 1)
X	{
X		zexpmod(a, e, n, bb);
X		return;
X	}
X	if (!exp_odd_powers)
X	{
X		exp_odd_powers = (verylong **)malloc((size_t)(NBITS * sizeof(verylong *)));
X		for (ei = 0; ei < NBITS; ei++)
X			exp_odd_powers[ei] = (verylong *) 0;
X	}
X	if (m <= 1)
X		m = zdefault_m(i);
X	else if (m >= NBITS)
X		m = (NBITS - 1);
X	{
X		register long k = 0;
X		register long od = 0;
X		register long odlen;
X		register long left;
X		register long zeros = 0;
X		register long rem = 0;
X		register long first = 1;
X		register long reach = 1;
X		verylong **loc_pow = &(exp_odd_powers[m]);
X
X		init_odd_power(a, n, &a_sq, m, loc_pow);
X		for (; i > 0; i--)
X		{
X			ei = e[i];
X			if (!k)
X			{
X				k = 1;
X				while (k <= ei)
X					k <<= 1;
X			}
X			while (k >>= 1)
X			{
X				if (zeros)
X				{
X					if (ei & k)
X					{
X						odlen = od = 1;
X						rem = zeros;
X						left = zeros = 0;
X					}
X					else
X						zeros++;
X				}
X				else if (!od)
X				{
X					if (ei & k)
X					{
X						odlen = od = 1;
X						left = zeros = 0;
X					}
X					else
X						zeros = 1;
X				}
X				else
X				{
X					left++;
X					if (odlen + left == m)
X					{
X						if (ei & k)
X						{
X							od <<= left;
X							odlen += left;
X							left = 0;
X							od++;
X							od >>= 1;
X							for (; reach <= od; reach++)
X								zmulmod((*loc_pow)[reach - 1], a_sq, n, &((*loc_pow)[reach]));
X							if (first)
X							{
X								zcopy((*loc_pow)[od], bb);
X								first = rem = odlen = od = 0;
X							}
X							else
X							{
X								for (rem = rem + odlen; rem; rem--)
X									zsqmod(*bb, n, bb);
X								zmulmod(*bb, (*loc_pow)[od], n, bb);
X								odlen = od = 0;
X							}
X						}
X						else
X						{
X							if (first)
X							{
X								if (od == 1)
X								{
X									zcopy(a_sq, bb);
X									left--;
X								}
X								else
X								{
X									od >>= 1;
X									for (; reach <= od; reach++)
X										zmulmod((*loc_pow)[reach - 1], a_sq, n, &((*loc_pow)[reach]));
X									zcopy((*loc_pow)[od], bb);
X								}
X								zeros = left;
X								first = left = odlen = od = rem = 0;
X							}
X							else
X							{
X								for (rem = rem + odlen; rem; rem--)
X									zsqmod(*bb, n, bb);
X								od >>= 1;
X								for (; reach <= od; reach++)
X									zmulmod((*loc_pow)[reach - 1], a_sq, n, &((*loc_pow)[reach]));
X								zmulmod(*bb, (*loc_pow)[od], n, bb);
X								zeros = left;
X								left = odlen = od = 0;
X							}
X						}
X					}
X					else if (ei & k)
X					{
X						od <<= left;
X						odlen += left;
X						left = 0;
X						od++;
X					}
X				}
X			}
X			k = RADIX;
X		}
X		if (od)
X		{
X			if (first)
X			{
X				if (od == 1)
X				{
X					zcopy(a_sq, bb);
X					left--;
X				}
X				else
X				{
X					od >>= 1;
X					for (; reach < od; reach++)
X						zmulmod((*loc_pow)[reach - 1], a_sq, n, &((*loc_pow)[reach]));
X					zmulmod((*loc_pow)[od - 1], a_sq, n, bb);
X				}
X			}
X			else
X			{
X				for (rem = rem + odlen; rem; rem--)
X					zsqmod(*bb, n, bb);
X				od >>= 1;
X				for (; reach <= od; reach++)
X					zmulmod((*loc_pow)[reach - 1], a_sq, n, &((*loc_pow)[reach]));
X				zmulmod(*bb, (*loc_pow)[od], n, bb);
X			}
X		}
X		if (left || zeros)
X		{
X			for (rem = zeros + left; rem; rem--)
X				zsqmod(*bb, n, bb);
X		}
X	}
X
X	if (e[0] < 0 && zinv(*bb, n, bb))
X		zhalt("undefined result in zexpmod_m_ary");
X}
X
Xvoid
Xzsexp(
X	verylong a,
X	long e,
X	verylong *bb
X	)
X{
X	static verylong le = 0;
X
X	zintoz(e, &le);
X	zexp(a, le, bb);
X}
X
Xvoid
Xzexp(
X	verylong a,
X	verylong e,
X	verylong *bb
X	)
X{
X	register long i;
X	register long j;
X	register long k = 0;
X	long sa;
X	verylong b = (*bb);
X	static verylong temp = 0;
X/*	extern double log10(); */
X
X	if (ALLOCATE && !e)
X	{
X		zone(bb);
X		return;
X	}
X	if (ALLOCATE && !a)
X	{
X		zzero(bb);
X		return;
X	}
X	if ((e[0] == 1) && (!(e[1])))
X		zone(bb);
X	else if ((a[1] == 1) && (a[0] == 1))
X		zone(bb);
X	else if ((a[1] == 1) && (a[0] == -1))
X	{
X		if (e[1] & 1)
X			zintoz((long) (-1), bb);
X		else
X			zone(bb);
X	}
X	else if (e[0] < 0)
X	{
X		zhalt("negative exponent in zexp");
X		return;
X	}
X	else if (!(a[1]) && (a[0] == 1))
X		zzero(bb);
X	else
X	{
X		if ((sa = a[0]) < 0)
X			sa = (-sa);
X		i = (long) ((sa - 1 + log10((double) (a[sa])) / LOG10RAD) * ztoint(e) + 4);
X		zsetlength(&b, i, "in zexp, third argument");
X		zsetlength(&temp, i, "in zexp, local");
X		for (i = sa; i >= 0; i--)
X			b[i] = a[i];
X		for (i = e[0]; i; i--)
X		{
X			j = e[i];
X			if (!k)
X			{
X				k = 1;
X				while ((k << 1) <= j)
X					k <<= 1;
X			}
X			while (k >>= 1)
X			{
X				zsqin(&b);
X				if (j & k)
X					zmulin(a, &b);
X			}
X			k = RADIX;
X		}
X		*bb = b;
X	}
X}
X
Xlong 
Xzexpmods(
X	long a,
X	long e,
X	long n
X	)
X{
X	if (!e)
X		return (1);
X	else
X	{
X		register long aa = a % n;
X		register long ipow2 = 1;
X		long b = aa;
X
X		if (e<0) e = -e;
X		while ((ipow2 << 1) <= e)
X			ipow2 <<= 1;
X		while (ipow2 >>= 1)
X		{
X			b = zmulmods(b, b, n);
X			if (e & ipow2)
X				b = zmulmods(b, aa, n);
X		}
X		return (b);
X	}
X}
X
Xvoid
Xzexpmod_doub1(
X	verylong xx1,
X	verylong ee1,
X	verylong xx2,
X	verylong ee2,
X	verylong n,
X	verylong *r
X	)
X{
X        register long bit11, bit21;
X        register long i,j,mask,block;
X        static verylong tab[2][2];
X        static long non_ini = 1;
X        static verylong e1 = 0;
X        static verylong e2 = 0;
X        if (ALLOCATE && !n)
X        {
X                zhalt("modulus zero in zexpmod_doub1");
X                return;
X        }
X        if ((zscompare(ee1,0)<0) || (zscompare(ee2,0)<0)) {
X                zhalt("negative exponent in zexpmod_doub1");
X                zintoz(0,r);
X                return;
X        }
X	if (non_ini) {
X		for (i=0;i<2;i++) for (j=0;j<2;j++)
X			tab[i][j] = 0;
X		non_ini = 0;
X	}
X#define MOD_INITPAR \
X        if (zcompare(ee1,ee2)>=0) { \
X		zcopy(xx1,&(tab[1][0])); \
X		zcopy(xx2,&(tab[0][1])); \
X                zcopy(ee1,&e1); \
X                zcopy(ee1,&e2); /* create space for e2 */ \
X                zcopy(ee2,&e2); \
X        } else { \
X		zcopy(xx2,&(tab[1][0])); \
X		zcopy(xx1,&(tab[0][1])); \
X                zcopy(ee2,&e2); /* create space for e2 */ \
X                zcopy(ee1,&e2); \
X                zcopy(ee2,&e1); \
X        } \
X        if (!(zscompare(e1,0))) { \
X		zintoz(1,r); \
X                return; \
X        } \
X        for (i=e2[0]+1;i<=e1[0];i++) e2[i] = 0;
X
X	MOD_INITPAR
X
X	zmulmod(tab[1][0],tab[0][1],n,&(tab[1][1]));
X
X	block = z2log(e1)-1;
X        mask = ( 1<<(block % NBITS) );
X        block = (block / NBITS) +1;
X        bit11 = 1;
X        bit21 = (e2[block]&mask) ? 1 : 0;
X	zcopy(tab[1][bit21],r);
X
X#define MOD_FIRST \
X	mask >>= 1; \
X	if (!mask) { \
X		block --; \
X		if (!block) return; \
X		mask  = ( 1 <<(NBITS-1) ); \
X	} \
X	bit11 = (e1[block]&mask) ? 1 : 0; \
X	bit21 = (e2[block]&mask) ? 1 : 0; 
X
X	MOD_FIRST
X	for (;;) {
X		zsqmod(*r,n,r);
X		if (bit11 || bit21) 
X			zmulmod(tab[bit11][bit21],*r,n,r);
X		MOD_FIRST
X	}
X}
X
Xvoid
Xzexpmod_doub2(
X	verylong xx1,
X	verylong ee1,
X	verylong xx2,
X	verylong ee2,
X	verylong n,
X	verylong *r
X	)
X{
X	register long i,j,mask,block;
X	register long bit11, bit12, bit21, bit22;
X	static verylong tab[4][4];
X	static long non_ini = 1;
X	static verylong e1 = 0;
X	static verylong e2 = 0;
X        if (ALLOCATE && !n)
X        {
X                zhalt("modulus zero in zexpmod_doub2");
X                return;
X        }
X	if ((zscompare(ee1,0)<0) || (zscompare(ee2,0)<0)) {
X		zhalt("negative exponent in zexpmod_doub2");
X		zintoz(0,r);
X		return;
X	}
X	if (non_ini) {
X		for (i=0;i<4;i++) for (j=0;j<4;j++)
X			tab[i][j] = 0;
X		non_ini = 0;
X	}
X
X	MOD_INITPAR
X
X	zsqmod(tab[1][0],n,&(tab[2][0]));
X	zsqmod(tab[0][1],n,&(tab[0][2]));
X	zmulmod(tab[2][0],tab[1][0],n,&(tab[3][0]));
X	zmulmod(tab[0][2],tab[0][1],n,&(tab[0][3]));
X	for (j=1;j<4;j++) {
X		for (i=1;i<4;i++) if ((i&1) | (j&1))
X			zmulmod(tab[j][0],tab[0][i],n,&(tab[j][i]));
X	}
X
X	block = z2log(e1)-1;
X	mask = ( 1<<(block % NBITS) );
X	block = (block / NBITS) +1;
X	bit11 = 1;
X	bit21 = (e2[block]&mask) ? 1 : 0;
X	mask >>= 1;
X	if (!mask) {
X		block --;
X		if (!block) {
X			zcopy(tab[1][bit21],r);
X			return;
X		}
X		mask = ( 1<<(NBITS-1) );
X	}
X	bit12 = (e1[block]&mask) ? 1 : 0;
X	bit22 = (e2[block]&mask) ? 1 : 0;
X	if (bit12 || bit22) {
X		zcopy(tab[2+bit12][(bit21<<1)+bit22],r);
X	} else {
X		zcopy(tab[bit11][bit21],r);
X		zsqmod(*r,n,r);
X	}
X
X#define MOD_SECOND \
X	mask >>= 1; \
X	if (!mask) { \
X		block--; \
X		if (!block) { \
X			zsqmod(*r,n,r); \
X			if (bit11||bit21) \
X				zmulmod(tab[bit11][bit21],*r,n,r); \
X			return; \
X		} \
X		mask = ( 1<<(NBITS-1) ); \
X	} \
X        bit12 = (e1[block]&mask) ? 1 : 0; \
X        bit22 = (e2[block]&mask) ? 1 : 0;
X
X	MOD_FIRST
X	MOD_SECOND
X	for (;;) {
X		zsqmod(*r,n,r);
X		if (bit11 || bit21) {
X			if (bit12 || bit22) {
X			  zsqmod(*r,n,r);
X			  zmulmod(tab[(bit11<<1)+bit12][(bit21<<1)+bit22],*r,n,r);
X			} else {
X			  zmulmod(tab[bit11][bit21],*r,n,r);
X			  zsqmod(*r,n,r);
X			}
X			MOD_FIRST
X		} else {
X			bit11 = bit12;
X			bit21 = bit22;
X		}
X		MOD_SECOND
X	}
X}
X
Xvoid
Xzexpmod_doub3(
X	verylong xx1,
X	verylong ee1,
X	verylong xx2,
X	verylong ee2,
X	verylong n,
X	verylong *r
X	)
X{
X	register long i,j, mask, block;
X	register long bit11, bit12, bit13, bit21, bit22, bit23;
X	static verylong tab[8][8];
X	static long non_ini = 1;
X	static verylong e1 = 0;
X	static verylong e2 = 0;
X        if (ALLOCATE && !n)
X        {
X                zhalt("modulus zero in zexpmod_doub3");
X                return;
X        }
X        if ((zscompare(ee1,0)<0) || (zscompare(ee2,0)<0)) {
X                zhalt("negative exponent in zexpmod_doub3");
X                zintoz(0,r);
X                return;
X        }
X	if (non_ini) {
X		for (i=0;i<8;i++) for (j=0;j<8;j++)
X			tab[i][j] = 0;
X		non_ini = 0;
X	}
X
X	MOD_INITPAR
X
X	zsqmod(tab[1][0],n,&(tab[2][0]));
X	zsqmod(tab[0][1],n,&(tab[0][2]));
X	for (i=3;i<8;i+=2) zmulmod(tab[2][0],tab[i-2][0],n,&(tab[i][0]));
X	for (i=3;i<8;i+=2) zmulmod(tab[0][2],tab[0][i-2],n,&(tab[0][i]));
X	for (i=1;i<8;i++) zmulmod(tab[0][1],tab[1][i-1],n,&(tab[1][i]));
X        for (i=1;i<8;i+=2) zmulmod(tab[0][i],tab[2][0],n,&(tab[2][i]));
X        for (i=1;i<8;i++) zmulmod(tab[0][1],tab[3][i-1],n,&(tab[3][i]));
X	for (j=4;j<8;j++) {
X		zmulmod(tab[1][0],tab[j-1][1],n,&(tab[j][1]));
X		for (i=3;i<8;i+=2) zmulmod(tab[0][2],tab[j][i-2],n,&(tab[j][i]));
X		j++;
X		for (i=1;i<8;i++) zmulmod(tab[0][1],tab[j][i-1],n,&(tab[j][i]));
X	}
X        block = z2log(e1)-1;
X        mask = ( 1<<(block % NBITS) );
X        block = (block / NBITS) +1;
X        bit11 = 1;
X        bit21 = (e2[block]&mask) ? 1 : 0;
X        mask >>= 1;
X        if (!mask) {
X                block --;
X                if (!block) {
X                        zcopy(tab[1][bit21],r);
X                        return;
X                }
X                mask = ( 1<<(NBITS-1) );
X        }
X        bit12 = (e1[block]&mask) ? 1 : 0;
X        bit22 = (e2[block]&mask) ? 1 : 0;
X	mask >>= 1;
X	if (!mask) {
X		block --;
X		if (!block) {
X			if (bit12 || bit22) {
X				zcopy(tab[2+bit12][(bit21<<1)+bit22],r);
X			} else {
X                		zcopy(tab[bit11][bit21],r);
X                		zsqmod(*r,n,r);
X			}
X			return;
X		}
X		mask = ( 1<<(NBITS-1) );
X	}
X	bit13 = (e1[block]&mask) ? 1 : 0;
X        bit23 = (e2[block]&mask) ? 1 : 0;
X	if (bit13 || bit23) {
X		zcopy(tab[4+(bit12<<1)+bit13][(bit21<<2)+(bit22<<1)+bit23],r);
X	} else {
X		if (bit12 || bit22) {
X			zcopy(tab[2+bit12][(bit21<<1)+bit22],r);
X		} else {
X			zcopy(tab[1][bit21],r);
X			zsqmod(*r,n,r);
X		}
X		zsqmod(*r,n,r);
X	}
X
X#define MOD_THIRD \
X	mask >>= 1; \
X	if (!mask) { \
X		block --; \
X                if (!block) { \
X			zsqmod(*r,n,r); \
X			if (bit11 || bit21) { \
X				if (bit12 || bit22) { \
X				  zsqmod(*r,n,r); \
X				  zmulmod(tab[(bit11<<1)+bit12][(bit21<<1)+bit22],*r,n,r); \
X				} else { \
X				  zmulmod(tab[bit11][bit21],*r,n,r); \
X				  zsqmod(*r,n,r); \
X				} \
X			} else { \
X				zsqmod(*r,n,r); \
X				if (bit12 || bit22) { \
X					zmulmod(tab[bit12][bit22],*r,n,r); \
X				} \
X			} \
X			return; \
X		} \
X		mask = ( 1<<(NBITS-1) ); \
X	} \
X	bit13 = (e1[block]&mask) ? 1 : 0; \
X        bit23 = (e2[block]&mask) ? 1 : 0;
X
X	MOD_FIRST
X	MOD_SECOND
X	MOD_THIRD
X
X	for (;;) {
X		zsqmod(*r,n,r);
X		if (bit11 || bit21) {
X			if (bit13 || bit23) {
X				zsqmod(*r,n,r);
X				zsqmod(*r,n,r);
X				zmulmod(tab[(bit11<<2)+(bit12<<1)+bit13]
X					    [(bit21<<2)+(bit22<<1)+bit23],*r,n,r);
X			} else {
X				if (bit12 || bit22) {
X					zsqmod(*r,n,r);
X					zmulmod(tab[(bit11<<1)+bit12]
X						    [(bit21<<1)+bit22],*r,n,r);
X				} else {
X					zmulmod(tab[bit11][bit21],*r,n,r);
X					zsqmod(*r,n,r);
X				}
X				zsqmod(*r,n,r);
X			}
X			MOD_FIRST
X			MOD_SECOND
X		} else {
X			bit11 = bit12;
X			bit21 = bit22;
X			bit12 = bit13;
X			bit22 = bit23;
X		}
X		MOD_THIRD
X	}
X
X}
X
Xvoid
Xzexpmod_doub(
X	verylong xx1,
X	verylong ee1,
X	verylong xx2,
X	verylong ee2,
X	verylong n,
X	verylong *r
X	)
X{
X        if (ALLOCATE && !n)
X        {
X                zhalt("modulus zero in zexpmod_doub");
X                return;
X        }
X        if ((zscompare(ee1,0)<0) || (zscompare(ee2,0)<0)) {
X                zhalt("negative exponent in zexpmod_doub");
X                zintoz(0,r);
X                return;
X        }
X	if (zscompare(ee1,1<<NBITS)<0 && zscompare(ee2,1<<NBITS)<0)
X		zexpmod_doub1(xx1,ee1,xx2,ee2,n,r);
X	else if (ee1[0]<10 && ee2[0]<10)
X		zexpmod_doub2(xx1,ee1,xx2,ee2,n,r);
X	else
X		zexpmod_doub3(xx1,ee1,xx2,ee2,n,r);
X}
X
Xvoid
Xzmontexp_doub1(
X	verylong xx1,
X	verylong ee1,
X	verylong xx2,
X	verylong ee2,
X	verylong *r
X	)
X{
X        register long bit11, bit21;
X        register long i,j,mask,block;
X        static verylong tab[2][2];
X        static long non_ini = 1;
X        static verylong e1 = 0;
X        static verylong e2 = 0;
X        if (!zn)
X        {
X                zhalt("undefined Montgomery modulus in zmontexp_doub1");
X                return;
X        }
X        if ((zscompare(ee1,0)<0) || (zscompare(ee2,0)<0)) {
X                zhalt("negative exponent in zmontexp_doub1");
X                zintoz(0,r);
X                return;
X        }
X	if (non_ini) {
X		for (i=0;i<2;i++) for (j=0;j<2;j++)
X			tab[i][j] = 0;
X		non_ini = 0;
X	}
X#define MONT_INITPAR \
X        if (zcompare(ee1,ee2)>=0) { \
X		zcopy(xx1,&(tab[1][0])); \
X		zcopy(xx2,&(tab[0][1])); \
X                zcopy(ee1,&e1); \
X                zcopy(ee1,&e2); /* create space for e2 */ \
X                zcopy(ee2,&e2); \
X        } else { \
X		zcopy(xx2,&(tab[1][0])); \
X		zcopy(xx1,&(tab[0][1])); \
X                zcopy(ee2,&e2); /* create space for e2 */ \
X                zcopy(ee1,&e2); \
X                zcopy(ee2,&e1); \
X        } \
X        if (!(zscompare(e1,0))) { \
X		zcopy(zr,r); \
X                return; \
X        } \
X        for (i=e2[0]+1;i<=e1[0];i++) e2[i] = 0;
X
X	MONT_INITPAR
X
X	zmontmul(tab[1][0],tab[0][1],&(tab[1][1]));
X
X	block = z2log(e1)-1;
X        mask = ( 1<<(block % NBITS) );
X        block = (block / NBITS) +1;
X        bit11 = 1;
X        bit21 = (e2[block]&mask) ? 1 : 0;
X	zcopy(tab[1][bit21],r);
X
X#define MONT_FIRST \
X	mask >>= 1; \
X	if (!mask) { \
X		block --; \
X		if (!block) return; \
X		mask  = ( 1 <<(NBITS-1) ); \
X	} \
X	bit11 = (e1[block]&mask) ? 1 : 0; \
X	bit21 = (e2[block]&mask) ? 1 : 0; \
X
X	MONT_FIRST
X	for (;;) {
X		zmontsq(*r,r);
X		if (bit11 || bit21) 
X			zmontmul(tab[bit11][bit21],*r,r);
X		MONT_FIRST
X	}
X}
X
Xvoid
Xzmontexp_doub2(
X	verylong xx1,
X	verylong ee1,
X	verylong xx2,
X	verylong ee2,
X	verylong *r
X	)
X{
X	register long i,j,mask,block;
X	register long bit11, bit12, bit21, bit22;
X	static verylong tab[4][4];
X	static long non_ini = 1;
X	static verylong e1 = 0;
X	static verylong e2 = 0;
X        if (!zn)
X        {
X                zhalt("undefined Montgomery modulus in zmontexp_doub2");
X                return;
X        }
X	if ((zscompare(ee1,0)<0) || (zscompare(ee2,0)<0)) {
X		zhalt("negative exponent in zmontexp_doub2");
X		zintoz(0,r);
X		return;
X	}
X	if (non_ini) {
X		for (i=0;i<4;i++) for (j=0;j<4;j++)
X			tab[i][j] = 0;
X		non_ini = 0;
X	}
X
X	MONT_INITPAR
X
X	zmontsq(tab[1][0],&(tab[2][0]));
X	zmontsq(tab[0][1],&(tab[0][2]));
X	zmontmul(tab[2][0],tab[1][0],&(tab[3][0]));
X	zmontmul(tab[0][2],tab[0][1],&(tab[0][3]));
X	for (j=1;j<4;j++) {
X		for (i=1;i<4;i++) if ((i&1) | (j&1))
X			zmontmul(tab[j][0],tab[0][i],&(tab[j][i]));
X	}
X
X	block = z2log(e1)-1;
X	mask = ( 1<<(block % NBITS) );
X	block = (block / NBITS) +1;
X	bit11 = 1;
X	bit21 = (e2[block]&mask) ? 1 : 0;
X	mask >>= 1;
X	if (!mask) {
X		block --;
X		if (!block) {
X			zcopy(tab[1][bit21],r);
X			return;
X		}
X		mask = ( 1<<(NBITS-1) );
X	}
X	bit12 = (e1[block]&mask) ? 1 : 0;
X	bit22 = (e2[block]&mask) ? 1 : 0;
X	if (bit12 || bit22) {
X		zcopy(tab[2+bit12][(bit21<<1)+bit22],r);
X	} else {
X		zcopy(tab[bit11][bit21],r);
X		zmontsq(*r,r);
X	}
X
X#define MONT_SECOND \
X	mask >>= 1; \
X	if (!mask) { \
X		block--; \
X		if (!block) { \
X			zmontsq(*r,r); \
X			if (bit11||bit21) \
X				zmontmul(tab[bit11][bit21],*r,r); \
X			return; \
X		} \
X		mask = ( 1<<(NBITS-1) ); \
X	} \
X        bit12 = (e1[block]&mask) ? 1 : 0; \
X        bit22 = (e2[block]&mask) ? 1 : 0;
X
X	MONT_FIRST
X	MONT_SECOND
X	for (;;) {
X		zmontsq(*r,r);
X		if (bit11 || bit21) {
X			if (bit12 || bit22) {
X			  zmontsq(*r,r);
X			  zmontmul(tab[(bit11<<1)+bit12][(bit21<<1)+bit22],*r,r);
X			} else {
X			  zmontmul(tab[bit11][bit21],*r,r);
X			  zmontsq(*r,r);
X			}
X			MONT_FIRST
X		} else {
X			bit11 = bit12;
X			bit21 = bit22;
X		}
X		MONT_SECOND
X	}
X}
X
Xvoid
Xzmontexp_doub3(
X	verylong xx1,
X	verylong ee1,
X	verylong xx2,
X	verylong ee2,
X	verylong *r
X	)
X{
X	register long i,j, mask, block;
X	register long bit11, bit12, bit13, bit21, bit22, bit23;
X	static verylong tab[8][8];
X	static long non_ini = 1;
X	static verylong e1 = 0;
X	static verylong e2 = 0;
X        if (!zn)
X        {
X                zhalt("undefined Montgomery modulus in zmontexp_doub3");
X                return;
X        }
X        if ((zscompare(ee1,0)<0) || (zscompare(ee2,0)<0)) {
X                zhalt("negative exponent in zmontexp_doub3");
X                zintoz(0,r);
X                return;
X        }
X	if (non_ini) {
X		for (i=0;i<8;i++) for (j=0;j<8;j++)
X			tab[i][j] = 0;
X		non_ini = 0;
X	}
X
X	MONT_INITPAR
X
X	zmontsq(tab[1][0],&(tab[2][0]));
X	zmontsq(tab[0][1],&(tab[0][2]));
X	for (i=3;i<8;i+=2) zmontmul(tab[2][0],tab[i-2][0],&(tab[i][0]));
X	for (i=3;i<8;i+=2) zmontmul(tab[0][2],tab[0][i-2],&(tab[0][i]));
X	for (i=1;i<8;i++) zmontmul(tab[0][1],tab[1][i-1],&(tab[1][i]));
X        for (i=1;i<8;i+=2) zmontmul(tab[0][i],tab[2][0],&(tab[2][i]));
X        for (i=1;i<8;i++) zmontmul(tab[0][1],tab[3][i-1],&(tab[3][i]));
X	for (j=4;j<8;j++) {
X		zmontmul(tab[1][0],tab[j-1][1],&(tab[j][1]));
X		for (i=3;i<8;i+=2) zmontmul(tab[0][2],tab[j][i-2],&(tab[j][i]));
X		j++;
X		for (i=1;i<8;i++) zmontmul(tab[0][1],tab[j][i-1],&(tab[j][i]));
X	}
X        block = z2log(e1)-1;
X        mask = ( 1<<(block % NBITS) );
X        block = (block / NBITS) +1;
X        bit11 = 1;
X        bit21 = (e2[block]&mask) ? 1 : 0;
X        mask >>= 1;
X        if (!mask) {
X                block --;
X                if (!block) {
X                        zcopy(tab[1][bit21],r);
X                        return;
X                }
X                mask = ( 1<<(NBITS-1) );
X        }
X        bit12 = (e1[block]&mask) ? 1 : 0;
X        bit22 = (e2[block]&mask) ? 1 : 0;
X	mask >>= 1;
X	if (!mask) {
X		block --;
X		if (!block) {
X			if (bit12 || bit22) {
X				zcopy(tab[2+bit12][(bit21<<1)+bit22],r);
X			} else {
X                		zcopy(tab[bit11][bit21],r);
X                		zmontsq(*r,r);
X			}
X			return;
X		}
X		mask = ( 1<<(NBITS-1) );
X	}
X	bit13 = (e1[block]&mask) ? 1 : 0;
X        bit23 = (e2[block]&mask) ? 1 : 0;
X	if (bit13 || bit23) {
X		zcopy(tab[4+(bit12<<1)+bit13][(bit21<<2)+(bit22<<1)+bit23],r);
X	} else {
X		if (bit12 || bit22) {
X			zcopy(tab[2+bit12][(bit21<<1)+bit22],r);
X		} else {
X			zcopy(tab[1][bit21],r);
X			zmontsq(*r,r);
X		}
X		zmontsq(*r,r);
X	}
X
X#define MONT_THIRD \
X	mask >>= 1; \
X	if (!mask) { \
X		block --; \
X                if (!block) { \
X			zmontsq(*r,r); \
X			if (bit11 || bit21) { \
X				if (bit12 || bit22) { \
X				  zmontsq(*r,r); \
X				  zmontmul(tab[(bit11<<1)+bit12][(bit21<<1)+bit22],*r,r); \
X				} else { \
X				  zmontmul(tab[bit11][bit21],*r,r); \
X				  zmontsq(*r,r); \
X				} \
X			} else { \
X				zmontsq(*r,r); \
X				if (bit12 || bit22) { \
X					zmontmul(tab[bit12][bit22],*r,r); \
X				} \
X			} \
X			return; \
X		} \
X		mask = ( 1<<(NBITS-1) ); \
X	} \
X	bit13 = (e1[block]&mask) ? 1 : 0; \
X        bit23 = (e2[block]&mask) ? 1 : 0;
X
X	MONT_FIRST
X	MONT_SECOND
X	MONT_THIRD
X
X	for (;;) {
X		zmontsq(*r,r);
X		if (bit11 || bit21) {
X			if (bit13 || bit23) {
X				zmontsq(*r,r);
X				zmontsq(*r,r);
X				zmontmul(tab[(bit11<<2)+(bit12<<1)+bit13]
X					    [(bit21<<2)+(bit22<<1)+bit23],*r,r);
X			} else {
X				if (bit12 || bit22) {
X					zmontsq(*r,r);
X					zmontmul(tab[(bit11<<1)+bit12]
X						    [(bit21<<1)+bit22],*r,r);
X				} else {
X					zmontmul(tab[bit11][bit21],*r,r);
X					zmontsq(*r,r);
X				}
X				zmontsq(*r,r);
X			}
X			MONT_FIRST
X			MONT_SECOND
X		} else {
X			bit11 = bit12;
X			bit21 = bit22;
X			bit12 = bit13;
X			bit22 = bit23;
X		}
X		MONT_THIRD
X	}
X
X}
X
Xvoid
Xzmontexp_doub(
X	verylong xx1,
X	verylong ee1,
X	verylong xx2,
X	verylong ee2,
X	verylong *r
X	)
X{
X        if (!zn)
X        {
X                zhalt("undefined Montgomery modulus in zmontexp_doub");
X                return;
X        }
X        if ((zscompare(ee1,0)<0) || (zscompare(ee2,0)<0)) {
X                zhalt("negative exponent in zmontexp_doub");
X                zintoz(0,r);
X                return;
X        }
X	if (zscompare(ee1,1<<NBITS)<0 && zscompare(ee2,1<<NBITS)<0)
X		zmontexp_doub1(xx1,ee1,xx2,ee2,r);
X	else if (ee1[0]<10 && ee2[0]<10)
X		zmontexp_doub2(xx1,ee1,xx2,ee2,r);
X	else
X		zmontexp_doub3(xx1,ee1,xx2,ee2,r);
X}
X
Xvoid
Xz2mul(
X	verylong n,
X	verylong *rres
X	)
X{
X	register long sn;
X	register long i;
X	register long carry = 0;
X	verylong res = *rres;
X
X	if (ALLOCATE && !n)
X	{
X		zzero(rres);
X		return;
X	}
X	if ((!n[1]) && (n[0] == 1))
X	{
X		zzero(rres);
X		return;
X	}
X	if ((sn = n[0]) < 0)
X		sn = -sn;
X	zsetlength(&res, sn + 1, "in z2mul, second argument");
X	if (n == *rres) n = res;
X	*rres = res;
X	for (i = 1; i <= sn; i++)
X	{
X		if ((res[i] = (n[i] << 1) + carry) >= RADIX)
X		{
X			res[i] -= RADIX;
X			carry = 1;
X		}
X		else
X			carry = 0;
X	}
X	if (carry)
X		res[++sn] = 1;
X	if (n[0] < 0)
X		res[0] = -sn;
X	else
X		res[0] = sn;
X}
X
Xlong 
Xz2div(
X	verylong n,
X	verylong *rres
X	)
X{
X	register long sn;
X	register long i;
X	register long result;
X	verylong res = *rres;
X
X	if ((!n) || (!n[1]) && (n[0] == 1))
X	{
X		zzero(rres);
X		return (0);
X	}
X	if ((sn = n[0]) < 0)
X		sn = -sn;
X	zsetlength(&res, sn, "in z2div, second argument");
X	if (n == *rres) n = res;
X	*rres = res;
X	result = n[1] & 1;
X	for (i = 1; i < sn; i++)
X	{
X		res[i] = (n[i] >> 1);
X		if (n[i + 1] & 1)
X			res[i] += (RADIX >> 1);
X	}
X	if (res[sn] = (n[sn] >> 1))
X		res[0] = n[0];
X	else if (sn == 1)
X	{
X		res[0] = 1;
X	}
X	else if (n[0] < 0)
X		res[0] = -sn + 1;
X	else
X		res[0] = sn - 1;
X	return (result);
X}
X
Xlong 
Xz2mod(
X	verylong n
X	)
X{
X	if (!n)
X		return (0);
X	return (n[1] & 1);
X}
X
Xvoid
Xzlshift(
X	verylong n,
X	long k,
X	verylong *rres
X	)
X{
X	register long big;
X	register long small;
X	register long sn;
X	register long i;
X	register long cosmall;
X	verylong res = *rres;
X
X	if (ALLOCATE && !n)
X	{
X		zzero(rres);
X		return;
X	}
X	if ((!n[1]) && (n[0] == 1))
X	{
X		zzero(rres);
X		return;
X	}
X	if (!k)
X	{
X		if (n != *rres)
X			zcopy(n, rres);
X		return;
X	}
X	if (k < 0)
X	{
X		zrshift(n, -k, rres);
X		return;
X	}
X	if (k == 1)
X	{
X		z2mul(n, rres);
X		return;
X	}
X	if ((sn = n[0]) < 0)
X		sn = -sn;
X	i = sn + (big = k / NBITS);
X	if (small = k - big * NBITS)
X	{
X		zsetlength(&res, i + 1, "in zlshift, third argument");
X		if (n == *rres) n = res;
X		*rres = res;
X		res[i + 1] = n[sn] >> (cosmall = NBITS - small);
X		for (i = sn; i > 1; i--)
X			res[i + big] = ((n[i] << small) & RADIXM) + (n[i - 1] >> cosmall);
X		res[big + 1] = (n[1] << small) & RADIXM;
X		for (i = big; i; i--)
X			res[i] = 0;
X		if (res[sn + big + 1])
X			big++;
X	}
X	else
X	{
X		zsetlength(&res, i, "in zlshift, third argument");
X		if (n == *rres) n = res;
X		*rres = res;
X		for (i = sn; i; i--)
X			res[i + big] = n[i];
X		for (i = big; i; i--)
X			res[i] = 0;
X	}
X	if (n[0] > 0)
X		res[0] = n[0] + big;
X	else
X		res[0] = n[0] - big;
X}
X
Xvoid
Xzrshift(
X	verylong n,
X	long k,
X	verylong *rres
X	)
X{
X	register long big;
X	register long small;
X	register long sn;
X	register long i;
X	register long cosmall;
X	verylong res = *rres;
X
X	if (ALLOCATE && !n)
X	{
X		zzero(rres);
X		return;
X	}
X	if ((!n[1]) && (n[0] == 1))
X	{
X		zzero(rres);
X		return;
X	}
X	if (!k)
X	{
X		if (n != *rres)
X			zcopy(n, rres);
X		return;
X	}
X	if (k < 0)
X	{
X		zlshift(n, -k, rres);
X		return;
X	}
X	if (k == 1)
X	{
X		z2div(n, rres);
X		return;
X	}
X	big = k / NBITS;
X	small = k - big * NBITS;
X	if ((sn = n[0]) < 0)
X		sn = -sn;
X	if ((big >= sn) || ((big == sn - 1) && (!(n[sn] >> small))))
X	{
X		zzero(rres);
X		return;
X	}
X	sn -= big;
X	zsetlength(&res, sn, "in zrshift, third argument");
X	if (n == *rres) n = res;
X	*rres = res;
X	if (small)
X	{
X		cosmall = NBITS - small;
X		for (i = 1; i < sn; i++)
X			res[i] = (n[i + big] >> small) +
X				((n[i + big + 1] << cosmall) & RADIXM);
X		if (!(res[sn] = (n[sn + big] >> small)))
X			sn--;
X	}
X	else
X		for (i = 1; i <= sn; i++)
X			res[i] = n[i + big];
X	if (n[0] > 0)
X		res[0] = sn;
X	else
X		res[0] = -sn;
X}
X
Xlong 
Xzmakeodd(
X	verylong *nn
X	)
X{
X	verylong n = *nn;
X	register long i;
X	long shift = 1;
X
X	if (!n || (!n[1] && (n[0] == 1)))
X		return (-1);
X	while (!(n[shift]))
X		shift++;
X	i = n[shift];
X	shift = NBITS * (shift - 1);
X	while (!(i & 1))
X	{
X		shift++;
X		i >>= 1;
X	}
X	zrshift(n, shift, &n);
X	return (shift);
X}
X
Xlong 
Xzcomposite(
X	verylong *mm,
X	long t,
X	long firstbase
X	)
X{
X	register long sm = 0;
X	register long i;
X	register long j;
X	register long s;
X	register long loc_rand;
X	verylong m = *mm;
X	static verylong u = 0;
X	static verylong m1 = 0;
X	static verylong a = 0;
X
X	if (!m || m[0] < 0)
X		return (1);
X	if ((m[0] == 1) && (m[1] <= RADIXROOT))
X	{
X		sm = m[1];
X		if (sm < 2)
X			return (1);
X		if (sm == 2)
X			return (0);
X		if (!(sm & 1))
X			return (1);
X		i = 3;
X		while (i * i <= sm)
X		{
X			if (!(sm % i))
X				return (1);
X			i++;
X			i++;
X		}
X		return (0);
X	}
X	if (!(m[1] & 1))
X		return (1);
X	zsetlength(&u, (i = m[0]), "in zcomposite, locals\n");
X	zsetlength(&m1, i, "");
X	zsetlength(&a, i, "");
X	zsubpos(m, one, &m1);
X	zcopy(m1, &u);
X	s = zmakeodd(&u) - 1;
X	if (firstbase < 0)
X		firstbase = -firstbase;
X	if (!firstbase && (sm = (m[1]-3)) <= (RADIXROOT-3))
X		sm = RADIXM - 3;
X	if (t < 0)
X		i = -t;
X	else
X		i = t;
X	for (; i > 0; i--)
X	{
X		if (sm)
X		{
X			zintoz((loc_rand = (3 + zrandom(sm)) & RADIXM), &a);
X			zexpmod(a, u, m, &a);
X		}
X		else
X		{
X			if (firstbase == 2)
X				z2expmod(u, m, &a);
X			else
X			{
X				zintoz(firstbase, &a);
X				zexpmod(a, u, m, &a);
X			}
X			if ((sm = (m[1]-3)) <= (RADIXROOT-3))
X				sm = RADIXM - 3;
X		}
X		if ((a[0] != 1 || a[1] != 1) && zcompare(m1, a))
X		{
X			for (j = s; j; j--)
X			{
X				zsqmod(a, m, &a);
X				if (!zcompare(a, m1))
X					goto nexti;
X			}
X			if (t > 0)
X				return (1);
X			else
X			{
X				zsqmod(a, m, &a);
X				zsubmod(a, one, m, &a);
X				zintoz(loc_rand, &u);
X				zmulmod(a, u, m, &a);
X				if (!a[1] && a[0] == 1)
X				{
X					zcopy(a, &m);
X					return (-1);
X				}
X				zgcd(a, m, &u);
X				if (u[1] == 1 && u[0] == 1)
X					return (1);
X				zcopy(u, &m);
X				return (-2);
X			}
X		}
Xnexti:		;
X	}
X	return (0);
X}
X
Xlong 
Xzprime(
X	verylong n,
X	long t,
X	long firstbase
X	)
X{
X	if (t < 0)
X		t = -t;
X	return (1 - zcomposite(&n, t, firstbase));
X}
X
Xstatic void
Xzsmexp(
X	long a,
X	verylong e,
X	verylong *bb
X	)
X{
X/* mixed arithmetic exponentiation, only for in zmcomposite */
X /* with mixed montgomery and ordinary arithmetic */
X	register long i;
X	register long j;
X	register long k = 0;
X	verylong b = *bb;
X
X	if (ALLOCATE && !zn)
X	{
X		zhalt("wrong call to zsmexp   BUG");
X		return;
X	}
X	if (ALLOCATE && !e)
X	{
X		zcopy(zr, bb);
X		return;
X	}
X	if (ALLOCATE && !a)
X	{
X		zzero(bb);
X		return;
X	}
X	if ((i = e[0]) < 0)
X		i = (-i);	/* negative exponent made positive ... */
X	if ((i == 1) && (!(e[1])))
X		zcopy(zr, &b);
X	else
X	{
X		zintoz(a, &b);
X		ztom(b, &b);
X		for (; i; i--)
X		{
X			j = e[i];
X			if (!k)
X			{
X				k = 1;
X				while ((k << 1) <= j)
X					k <<= 1;
X			}
X			while (k >>= 1)
X			{
X				zmontsq(b, &b);
X				if (j & k)
X				{
X					zsmul(b, a, &b);
X					zmod(b, zn, &b);
X				}
X			}
X			k = RADIX;
X		}
X	}
X	*bb = b;
X}
X
Xlong 
Xzmcomposite(
X	verylong m,
X	long t
X	)
X{
X	register long sm = 0;
X	register long i;
X	register long j;
X	register long s;
X	static verylong u = 0;
X	static verylong m1 = 0;
X	static verylong a = 0;
X
X	if (!m || m[0] < 0)
X		return (1);
X	if ((m[0] == 1) && (m[1] <= RADIXROOT))
X	{
X		sm = m[1];
X		if (sm < 2)
X			return (1);
X		if (sm == 2)
X			return (0);
X		if (!(sm & 1))
X			return (1);
X		i = 3;
X		while (i * i <= sm)
X		{
X			if (!(sm % i))
X				return (1);
X			i++;
X			i++;
X		}
X		return (0);
X	}
X	if (!(m[1] & 1))
X		return (1);
X	zsetlength(&u, (i = m[0]), "in zmcomposite, locals\n");
X	zsetlength(&m1, i, "");
X	zsetlength(&a, i, "");
X	zmkeep(m);
X	zsubpos(m, zr, &m1);	/* zr is montgomery-one, m1 is
X				 * montgomery-(n-1) */
X	zsubpos(m, one, &u);
X	s = zmakeodd(&u) - 1;
X	if ((sm = m[1]) <= RADIXROOT)
X		sm = RADIXM - 3;
X	if (t < 0)
X		t = -t;
X	for (i = t; i > 0; i--)
X	{
X		zsmexp((3 + zrandom(sm)) & RADIXM, u, &a);
X		if (zcompare(zr, a) && zcompare(m1, a))
X		{
X			for (j = s; j; j--)
X			{
X				zmontsq(a, &a);
X				if (!zcompare(a, m1))
X					goto nexti;
X			}
X			zmback();
X			return (1);
X		}
Xnexti:		;
X	}
X	zmback();
X	return (0);
X}
X
Xlong 
Xzsqrts(
X	long n
X	)
X{
X	register long a;
X	register long ndiva;
X	register long newa;
X	static verylong ln=0;
X	static verylong rr=0;
X	static verylong dif=0;
X
X	if (n <= 0)
X		return (0);
X	if (n <= 3)
X		return (1);
X	if (n <= 8)
X		return (2);
X	if (n >= RADIX)
X	{
X		zintoz(n,&ln);
X		zsqrt(ln,&rr,&dif);
X		return(ztoint(rr));
X	}
X	newa = 3 << (2 * (NBITSH - 1));
X	a = 1 << NBITSH;
X	while (!(n & newa))
X	{
X		newa >>= 2;
X		a >>= 1;
X	}
X	while (1)
X	{
X		newa = ((ndiva = n / a) + a) / 2;
X		if (newa - ndiva <= 1)
X		{
X			if (newa * newa <= n)
X				return (newa);
X			else
X				return (ndiva);
X		}
X		a = newa;
X	}
X}
X
Xlong 
Xzsqrt(
X	verylong n_in,
X	verylong *rr,
X	verylong *ddif
X	)
X{
X	static verylong n = 0;
X	static verylong a = 0;
X	static verylong ndiva = 0;
X	static verylong diff = 0;
X	register long i;
X	verylong dif = *ddif;
X	verylong r = *rr;
X
X	if (ALLOCATE && !n_in)
X	{
X		zzero(rr);
X		zzero(ddif);
X		return (1);
X	}
X	if ((i = n_in[0]) < 0)
X	{
X		zhalt("negative argument in zsqrt");
X		return (0);
X	}
X	zcopy(n_in,&n);
X	zsetlength(&a, i, "in zsqrt, locals\n");
X	zsetlength(&ndiva, i, "");
X	zsetlength(&diff, i, "");
X	if (i == 1)
X	{
X		zintoz(i = zsqrts(n[1]), &r);
X		zintoz(i * i, &diff);
X		goto done;
X	}
X	a[(a[0] = (i + 1) / 2)] = zsqrts(n[i]) + 1;
X	if (!(i & 1))
X		a[a[0]] <<= NBITSH;
X	if (a[a[0]] & RADIX)
X	{
X		a[a[0]] = 0;
X		a[0]++;
X		a[a[0]] = 1;
X	}
X	for (i = a[0] - 1; i; i--)
X		a[i] = 0;
X	while (1)
X	{
X		zdiv(n, a, &ndiva, &r);
X		zadd(a, ndiva, &r);
X		zrshift(r, (long) 1, &r);
X		if (zcompare(r, ndiva) <= 0)
X		{
X			zsq(r, &diff);
X			goto done;
X		}
X		zsubpos(r, ndiva, &diff);
X		if ((diff[0] == 1) && (diff[1] <= 1))
X		{
X			zsq(r, &diff);
X			if (zcompare(diff, n) > 0)
X			{
X				zcopy(ndiva, &r);
X				zsq(r, &diff);
X			}
X			goto done;
X		}
X		zcopy(r, &a);
X	}
Xdone:
X	*rr = r;
X	zsubpos(n, diff, &dif);
X	*ddif = dif;
X	if (!(dif[1]) && (dif[0] == 1))
X		return (1);
X	return (0);
X}
X
Xvoid
Xzpstart()
X{
X	register long i;
X	register long j;
X	register long jstep;
X	register long jstart;
X	register long ibnd;
X	register short int *p;
X
X	if (!lowsieve)
X	{
X		lowsieve = (short int *)calloc((size_t)PRIMBND, sizeof(short int));
X		p = &lowsieve[0];
X		for (i = PRIMBND; i; i--)
X			*p++ = 1;
X		jstep = 1;
X		jstart = -1;
X		ibnd = (zsqrts((long) (2 * PRIMBND + 1)) - 3) / 2;
X		for (i = 0; i <= ibnd; i++)
X		{
X			jstart += 2 * ((jstep += 2) - 1);
X			if (lowsieve[i])
X				for (j = jstart; j < PRIMBND; j += jstep)
X					lowsieve[j] = 0;
X		}
X	}
X	lastp = 0;
X	pshift = 0;
X	pindex = -1;
X}
X
Xvoid
Xzpstart2()
X{
X	lastp = 0;
X	pshift = -1;
X}
X
Xstatic void
Xzpshift()
X{
X/* auxiliary routine for prime generator */
X	register long i;
X	register long j;
X	register long jstep;
X	register long jstart;
X	register long ibound;
X	register short *p;
X	register short *pi;
X
X	if (!movesieve)
X		movesieve = (short int *)calloc((size_t)PRIMBND, sizeof(short int));
X	pi = &movesieve[0];
X	if (!pshift)
X	{
X		p = &lowsieve[0];
X		for (i = PRIMBND; i; i--)
X			*pi++ = *p++;
X	}
X	else
X	{
X		for (i = PRIMBND; i; i--)
X			*pi++ = 1;
X		jstep = 3;
X		ibound = pshift + 2 * PRIMBND + 1;
X		for (i = 0; jstep * jstep <= ibound; i++)
X		{
X			if (lowsieve[i])
X			{
X				if (!((jstart = (pshift + 2) / jstep + 1) & 1))
X					jstart++;
X				if (jstart <= jstep)
X					jstart = jstep;
X				jstart = (jstart * jstep - pshift - 3) / 2;
X				for (j = jstart; j < PRIMBND; j += jstep)
X					movesieve[j] = 0;
X			}
X			jstep += 2;
X		}
X	}
X}
X
Xlong 
Xzpnext()
X{
X	if (pshift < 0)
X	{
X		zpstart();
X		return (lastp = 2);
X	}
X	if (pindex < 0)
X	{
X		pindex = 0;
X		zpshift();
X		return (lastp = 3);
X	}
X	for (;;)
X	{
X		while ((++pindex) < PRIMBND)
X		{
X			if (movesieve[pindex])
X				return (lastp = pshift + 2 * pindex + 3);
X		}
X		if ((pshift += 2 * PRIMBND) > 2 * PRIMBND * (2 * PRIMBND + 1))
X		{
X			zpstart();
X			return (lastp = 2);
X		}
X		zpshift();
X		pindex = -1;
X	}
X}
X
Xlong 
Xzp()
X{
X	return (lastp);
X}
X
Xvoid
Xzgcd(
X	verylong mm1,
X	verylong mm2,
X	verylong *rres
X	)
X{
X	register long agrb;
X	register long shibl;
X	static verylong aa = 0;
X	static verylong bb = 0;
X	static verylong cc = 0;
X	verylong a;
X	verylong b;
X	verylong c;
X	verylong d;
X	long m1negative;
X	long m2negative;
X
X	if (!mm1)
X	{
X		if (mm2 != *rres)
X			zcopy(mm2,rres);
X		zabs(rres);
X		return;
X	}
X	if (!mm2)
X	{
X		if (mm1 != *rres)
X			zcopy(mm1,rres);
X		zabs(rres);
X		return;
X	}
X	if (mm1 == mm2)
X	{
X		if (mm1 != *rres)
X			zcopy(mm1, rres);
X		zabs(rres);
X		return;
X	}
X	if (m1negative = (mm1[0] < 0))
X		mm1[0] = -mm1[0];
X	if (m2negative = (mm2[0] < 0))
X		mm2[0] = -mm2[0];
X	if (!(mm1[1]) && (mm1[0] == 1))
X	{
X		a = mm2;
X		goto done;
X	}
X	if (!(mm2[1]) && (mm2[0] == 1))
X	{
X		a = mm1;
X		goto done;
X	}
X	if ((agrb = mm1[0]) < mm2[0])
X		agrb = mm2[0];
X	zsetlength(&aa, agrb, "in zgcd, locals\n");
X	zsetlength(&bb, agrb, "");
X	zsetlength(&cc, agrb, "");
X	if (mm1[0] != mm2[0])
X	{
X		if (mm1[0] > mm2[0])
X		{
X			zcopy(mm2, &aa);
X			zmod(mm1, aa, &bb);
X		}
X		else
X		{
X			zcopy(mm1, &aa);
X			zmod(mm2, aa, &bb);
X		}
X		if (!(bb[1]) && (bb[0] == 1))
X		{
X			a = aa;
X			goto done;
X		}
X	}
X	else
X	{
X		zcopy(mm1, &aa);
X		zcopy(mm2, &bb);
X	}
X	if ((agrb = zmakeodd(&aa)) < (shibl = zmakeodd(&bb)))
X		shibl = agrb;
X	if (!(agrb = zcompare(aa, bb)))
X	{
X		a = aa;
X		goto endshift;
X	}
X	else if (agrb < 0)
X	{
X		a = bb;
X		b = aa;
X	}
X	else
X	{
X		a = aa;
X		b = bb;
X	}
X	c = cc;
X	zsubpos(a, b, &c);
X	do
X	{
X		zmakeodd(&c);
X		if (!(agrb = zcompare(b, c)))
X		{
X			a = b;
X			goto endshift;
X		}
X		else if (agrb > 0)
X		{
X			a = b;
X			b = c;
X			c = a;
X		}
X		else
X		{
X			d = a;
X			a = c;
X			c = d;
X		}
X		zsubpos(a, b, &c);
X	} while (c[1] || c[0] != 1);
Xendshift:
X	zlshift(a, shibl, &a);
Xdone:
X	if (m1negative)
X		mm1[0] = -mm1[0];
X	if (m2negative)
X		mm2[0] = -mm2[0];
X	zcopy(a, rres);
X}
X
Xvoid
Xzgcdeucl(
X	verylong mm1,
X	verylong mm2,
X	verylong *rres
X	)
X{
X	register long agrb;
X	static verylong aa = 0;
X	static verylong bb = 0;
X	verylong a;
X	long m1negative;
X	long m2negative;
X
X	if (!mm1)
X	{
X		if (mm2 != *rres)
X			zcopy(mm2, rres);
X		zabs(rres);
X		return;
X	}
X	if (!mm2)
X	{
X		if (mm1 != *rres)
X			zcopy(mm1, rres);
X		zabs(rres);
X		return;
X	}
X	if (mm1 == mm2)
X	{
X		if (mm1 != *rres)
X			zcopy(mm1, rres);
X		zabs(rres);
X		return;
X	}
X	if (m1negative = (mm1[0] < 0))
X		mm1[0] = -mm1[0];
X	if (m2negative = (mm2[0] < 0))
X		mm2[0] = -mm2[0];
X	if (!(mm1[1]) && (mm1[0] == 1))
X	{
X		a = mm2;
X		goto done;
X	}
X	if (!(mm2[1]) && (mm2[0] == 1))
X	{
X		a = mm1;
X		goto done;
X	}
X	if ((agrb = mm1[0]) < mm2[0])
X		agrb = mm2[0];
X	zsetlength(&aa, agrb, "in zgcdeucl, locals\n");
X	zsetlength(&bb, agrb, "");
X	zcopy(mm1, &aa);
X	zcopy(mm2, &bb);
X	while (bb[1] || (bb[0] != 1))
X	{
X		zmod(aa, bb, &aa);
X		if (!(aa[1]) && (aa[0] == 1))
X		{
X			a = bb;
X			goto done;
X		}
X		zmod(bb, aa, &bb);
X	}
X	a = aa;
Xdone:
X	if (m1negative)
X		mm1[0] = -mm1[0];
X	if (m2negative)
X		mm2[0] = -mm2[0];
X	zcopy(a, rres);
X}
X
Xvoid
Xtimer_handler()
X{
X	time_flag = 0;
X}
X
Xlong 
Xzpollardrho(
X	verylong n,
X	verylong *rres,
X	verylong *ccof,
X	long t
X	)
X{
X	register long i;
X	register long j = 10;
X	static verylong xi = 0;
X	static verylong x2i = 0;
X	static verylong dif = 0;
X	verylong res = *rres;
X	verylong cof = *ccof;
X	verylong adder = &glosho[1];
X
X	time_flag = 1;
X	adder[1] = 1;
X	if (ALLOCATE && !n)
X	{
X		zzero(rres);
X		zzero(ccof);
X		return (0);
X	}
X	if (!n[1] && (n[0] == 1))
X	{
X		zzero(rres);
X		zzero(ccof);
X		return (0);
X	}
X	if (n[0] < 0)
X	{
X		zintoz((long) (-1), rres);
X		zcopy(n, ccof);
X		return (1);
X	}
X	if (!(n[1] & 1))
X	{
X		zintoz((long) 2, rres);
X		zrshift(n, (long) 1, ccof);
X		if (((*ccof)[1] != 1) || ((*ccof)[0] != 1))
X			return (1);
X		return (0);
X	}
X	zsetlength(&xi, (i = n[0] + 1), "in zpollardrho, locals\n");
X	zsetlength(&x2i, i, "");
X	zsetlength(&dif, i, "");
X	i = 0;
X	zmkeep(n);
X	zcopy(one, &dif);
X	ztom(dif, &xi);
X	zcopy(xi, &x2i);
X	while ((!t || i < t) && time_flag)
X	{
X		for (; i < j && time_flag; i++)
X		{
X			zmontsq(xi, &xi);
X			zadd(xi, adder, &xi);
X			zmontsq(x2i, &x2i);
X			zadd(x2i, adder, &x2i);
X			zmontsq(x2i, &x2i);
X			zadd(x2i, adder, &x2i);
X			zsub(xi, x2i, &res);
X			if (res[0] < 0)
X				res[0] = -res[0];
X			if ((res[1]) || (res[0] != 1))
X				zmontmul(dif, res, &dif);
X			else
X			{
X				zcopy(one, &dif);
X				ztom(dif, &xi);
X				zcopy(xi, &x2i);
X				if ((adder[1] += 2) > RADIX)
X				{
X					(void)signal(SIGALRM, SIG_IGN);
X					zmback();
X					return (0);
X				}
X			}
X		}
X		if ((dif[1]) || (dif[0] != 1))
X		{
X			zgcd(n, dif, &res);
X			if (((res[1] != 1) || (res[0] != 1)) && zcompare(res, n))
X			{
X				zdiv(n, res, &cof, &xi);
X				if (xi[1] || xi[0] != 1)
X				{
X					*rres = res;
X					*ccof = cof;
X					zhalt("wrong factor in zpollardrho   BUG");
X					(void)signal(SIGALRM, SIG_IGN);
X					zmback();
X					return (0);
X				}
X				if (zcompare(res, cof) > 0)
X				{
X					*rres = cof;
X					*ccof = res;
X				}
X				else
X				{
X					*rres = res;
X					*ccof = cof;
X				}
X				(void)signal(SIGALRM, SIG_IGN);
X				zmback();
X				return (i + 1);
X			}
X		}
X		else
X			zcopy(one, &dif);
X		j = i + 6;
X	}
X	if (!time_flag)
X	{
X		fprintf(stderr,"timed out in zpollardrho");
X		fflush(stderr);
X	}
X	else
X	{
X		(void)signal(SIGALRM, SIG_IGN);
X	}
X	zmback();
X	return (0);
X}
X
Xlong 
Xztridiv(
X	verylong n,
X	verylong *cof,
X	long b1,
X	long b2
X	)
X{
X
X	long old_lastp = lastp;
X	long old_pshift = pshift;
X	static long lasttried = 0;
X	if (ALLOCATE && !n)
X	{
X		zzero(cof);
X		return (0);
X	}
X	if (lasttried > b1)
X	{
X		zpstart2();
X		lasttried = 0;
X	}
X	while (lasttried < b1)
X	{
X		lasttried = zpnext();
X	}
X	while (lasttried <= b2)
X	{
X		if (!zsdiv(n, lasttried, cof))
X			goto done;
X		lasttried = zpnext();
X	}
X	done:
X	if (old_lastp != lastp)
X	{
X		if (old_pshift<0)
X			zpstart2();
X		else
X			zpstart();
X		if (old_lastp)
X			while (zpnext() != old_lastp) ;
X	}
X	return (lasttried);
X}
X
Xlong 
Xzfread(
X	FILE *f,
X	verylong *aa
X	)
X{
X /* return 1 if success, 0 if not */
X	static char *inmem = 0;
X	char *in;
X	register long d = 0;
X	register long anegative = 0;
X	register long return_value = 1;
X	verylong a = *aa;
X	verylong digit = &glosho[1];
X
X	if (!inmem)
X		inmem = (char *)calloc((size_t)BUFSIZE, sizeof(char));
X	if (fscanf(f, "%s", inmem) == EOF)
X		return (0);
X	if ((inmem[0] == '-') || (inmem[0] == '_'))
X	{
X		anegative = 1;
X		in = (inmem + 1);
X	}
X	else
X		in = inmem;
X	zsetlength(&a, (long) (strlen(in) / LOG10RAD), "in zfread, second argument");
X	a[0] = 1;
X	a[1] = 0;
X	while (in[d] != '\0')
X	{
X		if (in[d] == '\\')
X		{
X			if (fscanf(f, "%s", in) == EOF)
X				return (0);
X			d = 0;
X			if (strlen(in) > LOG10RAD * (a[-1] - a[0]))
X			{
X			/* to avoid multiple reallocations */
X				zsetlength(&a, (long) (a[0] + 3 + strlen(in) / LOG10RAD), 
X				           "in zfread, second argument");
X			}
X		}
X		else
X		{
X			zsmul(a, (long) 10, &a);
X			digit[1] = (long) (in[d++] - '0');
X                        if (digit[1] < 0) {
X                                digit[1] = 0;
X                                return_value = 0;
X                        } else if (digit[1] > 9) {
X                                return_value = 0;
X                        }
X			zadd(a, digit, &a);
X		};
X	}
X	if (anegative)
X		znegate(&a);
X	*aa = a;
X	return (return_value);
X}
X
Xlong 
Xzread(
X	verylong *a
X	)
X{
X	return (zfread(stdin, a));
X}
X
Xlong 
Xzfwrite(
X	FILE *f,
X	verylong a,
X	long linelen,
X	char *str1,
X	char *str2
X	)
X{
X	static verylong out = 0;
X	static verylong ca = 0;
X	static long outsize = 0;
X	static long div = 0;
X	static long ldiv;
X	register long i;
X	long sa;
X	long result;
X	long zeros;
X	long strlen1 = strlen(str1);
X	long strlen2 = strlen(str2);
X
X	if (ALLOCATE && !a)
X	{
X		fprintf(f, "0");
X		return (1);
X	}
X	if (!div)
X	{
X		div = 10;
X		ldiv = 1;
X		while (div * 10 < RADIXROOT)
X		{
X			div *= 10;
X			ldiv++;
X		}
X	}
X	if (linelen && linelen < ldiv)
X		linelen = LINE;
X	if (!out)
X		out = (verylong)calloc((size_t)(outsize = SIZE << 1), (size_t)SIZEOFLONG);
X	if ((sa = a[0]) < 0)
X	{
X		sa = -sa;
X		fprintf(f, "%s-", str1);
X	}
X	else
X		fprintf(f, "%s", str1);
X	if (ldiv * outsize < LOG10RAD * sa)
X	{
X		free((void*)out);
X		if (!(out = (verylong)calloc((size_t)(outsize = (LOG10RAD * sa) / ldiv + 2), (size_t)SIZEOFLONG))) {
X			zhalt("allocation failure in zfwrite");
X			return (0);
X		}
X	}
X	zsetlength(&ca, sa, "in zfwrite, local");
X	for (i = (ca[0] = sa); i; i--)
X		ca[i] = a[i];
X	i = -1;
X	do
X	{
X		if ((++i) >= outsize)
X		{
X			if (!(out = (verylong)realloc((void*)out, (size_t)((outsize += SIZE) * SIZEOFLONG))))
X			{
X				zhalt("reallocation failure in zfwrite");
X				return (0);
X			}
X		}
X		out[i] = zsdiv(ca, div, &ca);
X	} while (ca[1] || ca[0] != 1);
X	sa = 0;
X	result = out[i];
X	do
X	{
X		sa++;
X	} while (result /= 10);
X	result = sa + i * ldiv;;
X	fprintf(f, "%ld", out[i--]);
X	for (; i >= 0; i--)
X	{
X		if (zeros = 10 * out[i])
X		{
X			while (zeros < div)
X			{
X				fprintf(f, "0");
X				zeros *= 10;
X			}
X		}
X		else
X		{
X			for (zeros = ldiv - 1; zeros; zeros--)
X				fprintf(f, "0");
X		}
X		fprintf(f, "%ld", out[i]);
X		sa += ldiv;
X		if (linelen && (sa > linelen - strlen1) && i)
X		{
X			fprintf(f, "\\\n%s", str2);
X			sa = 0;
X			strlen1 = strlen2;
X		}
X	}
X	return (result);
X}
X
Xlong
Xzfwriteln(
X        FILE *f,
X        verylong a
X        )
X{
X	long ret = zfwrite(f, a, (long)LINE, "", "");
X
X        fprintf(f,"\n");
X        return (ret);
X}
X
Xlong 
Xzwrite(
X	verylong a
X	)
X{
X	return (zfwrite(stdout, a, (long)LINE, "", ""));
X}
X
Xlong 
Xzwriteln(
X	verylong a
X	)
X{
X	long ret = zfwrite(stdout, a, (long)LINE, "", "");
X
X	printf("\n");
X	return (ret);
X}
X
Xchar 
Xeulav(
X	long i
X	)
X{
X	switch (i)
X	{
X		case 0:
X			return ('0');
X		case 1:
X			return ('1');
X		case 2:
X			return ('2');
X		case 3:
X			return ('3');
X		case 4:
X			return ('4');
X		case 5:
X			return ('5');
X		case 6:
X			return ('6');
X		case 7:
X			return ('7');
X		case 8:
X			return ('8');
X		case 9:
X			return ('9');
X#ifdef LOWER
X		case 10:
X			return ('a');
X		case 11:
X			return ('b');
X		case 12:
X			return ('c');
X		case 13:
X			return ('d');
X		case 14:
X			return ('e');
X		case 15:
X			return ('f');
X#else
X		case 10:
X			return ('A');
X		case 11:
X			return ('B');
X		case 12:
X			return ('C');
X		case 13:
X			return ('D');
X		case 14:
X			return ('E');
X		case 15:
X			return ('F');
X#endif
X		default:
X			return ('?');
X	}
X}
X
Xvoid
Xzhfwrite(
X	FILE *fn,
X	verylong a
X	)
X{
X	static char *b = 0;
X	static bl = 0;
X	static verylong aa = 0;
X	register long i;
X	register long cnt = 0;
X	register long mb = 0;
X	register long lab = 0;
X
X	if (!a)
X		fprintf(fn, "0");
X	zcopy(a, &aa);
X	if (aa[0] < 0)
X	{
X		aa[0] = -aa[0];
X		fprintf(fn, "-");
X	}
X	if (!b)
X		b = (char *)malloc((size_t)(bl = (aa[0] << 3)));
X	else if (bl < (aa[0] << 3))
X		b = (char *)realloc((void*)b, (size_t)((bl = (aa[0] << 3)) * sizeof(char)));
X	do
X	{
X		b[cnt] = eulav(aa[1] & 15);
X		cnt++;
X		zrshift(aa, (long) 4, &aa);
X	} while ((aa[1] != 0) || (aa[0] != 1));
X	for (i = cnt; i--;)
X	{
X		fprintf(fn, "%c", b[i]);
X		mb++;
X		if (mb == 8)
X		{
X			lab++;
X			if (lab == 7)
X			{
X				if (i)
X					fprintf(fn, "\\\n");
X				lab = 0;
X				mb = 0;
X			}
X			else
X			{
X				mb = 0;
X				fprintf(fn, " ");
X			}
X		}
X	}
X
X}
X
Xvoid
Xzhfwriteln(
X        FILE *f,
X        verylong a
X        )
X{
X        zhfwrite(f, a);
X        fprintf(f, "\n");
X}
X
Xvoid
Xzhwrite(
X	verylong a
X	)
X{
X	zhfwrite(stdout, a);
X}
X
Xvoid
Xzhwriteln(
X	verylong a
X	)
X{
X	zhfwrite(stdout, a);
X	printf("\n");
X}
X
Xlong 
Xvalue(
X	char c
X	)
X{
X	switch (c)
X	{
X		case '0':
X			return (0);
X		case '1':
X			return (1);
X		case '2':
X			return (2);
X		case '3':
X			return (3);
X		case '4':
X			return (4);
X		case '5':
X			return (5);
X		case '6':
X			return (6);
X		case '7':
X			return (7);
X		case '8':
X			return (8);
X		case '9':
X			return (9);
X		case 'A':
X		case 'a':
X			return (10);
X		case 'B':
X		case 'b':
X			return (11);
X		case 'C':
X		case 'c':
X			return (12);
X		case 'D':
X		case 'd':
X			return (13);
X		case 'E':
X		case 'e':
X			return (14);
X		case 'F':
X		case 'f':
X			return (15);
X		default:
X			return(0);
X	}
X}
X
Xvoid
Xzhfread(
X	FILE *fn,
X	verylong *a
X	)
X{
X	char prev;
X	char c;
X	long anegative = 0;
X
X	zintoz((long) 0, a);
X	do
X	{
X		prev = ' ';
X		do
X		{
X			fscanf(fn, "%c", &c);
X		} while (c == '\n');
X		if (((c == '-') || (c =='_')) && (!anegative))
X		{
X			anegative = 1;
X			fscanf(fn, "%c", &c);
X		}
X		while (c != '\n')
X		{
X			prev = c;
X			fscanf(fn, "%c", &c);
X			if ((prev != '\\') && (prev != ' '))
X			{
X				zlshift(*a, (long) 4, a);
X				zsadd(*a, value(prev), a);
X			}
X		}
X		if (!anegative)
X			anegative = -1;
X	} while (prev == '\\');
X	if (anegative > 0)
X		if (((*a)[1]) || ((*a)[0] != 1))
X			(*a)[0] = -((*a)[0]);
X}
X
Xvoid
Xzhread(
X	verylong *a
X	)
X{
X	zhfread(stdin, a);
X}
X
Xlong 
Xzsread(
X	char *str,
X	verylong *aa
X	)
X{
X	static char *inmem = 0;
X	char *in;
X	register long d = 0;
X	register long anegative = 0;
X	register long return_value = 1;
X	verylong a = *aa;
X	verylong digit = &glosho[1];
X
X	if (!inmem)
X		inmem = (char *)calloc((size_t)BUFSIZE, sizeof(char));
X	if (sscanf(str, "%s", inmem) == EOF)
X		return (0);
X	if ((inmem[0] == '-') || (inmem[0] == '_'))
X	{
X		anegative = 1;
X		in = (inmem + 1);
X	}
X	else
X		in = inmem;
X	zsetlength(&a, (long) (strlen(in) / LOG10RAD), "in zsread, second argument");
X	a[0] = 1;
X	a[1] = 0;
X	while (in[d] != '\0')
X	{
X		if (in[d] == '\\')
X		{
X			if (sscanf(str, "%s", in) == EOF)
X				return (0);
X			d = 0;
X			if (strlen(in) > LOG10RAD * (a[-1] - a[0]))
X			{
X				zsetlength(&a, (long) (a[0] + 3 + strlen(in) / LOG10RAD), 
X				           "in zsread, second argument");
X			}
X		}
X		else
X		{
X			zsmul(a, (long) 10, &a);
X			digit[1] = (long) (in[d++] - '0');
X			if (digit[1] < 0) {
X				digit[1] = 0;
X				return_value = 0;
X			} else if (digit[1] > 9) {
X				return_value = 0;
X			}
X			zadd(a, digit, &a);
X		};
X	}
X	if (anegative)
X		znegate(&a);
X	*aa = a;
X	return (return_value);
X}
X
Xlong 
Xzswrite(
X	char *str,
X	verylong a
X	)
X{
X	static verylong out = 0;
X	static verylong ca = 0;
X	static long outsize = 0;
X	static long div = 0;
X	static long ldiv;
X	register long i;
X	register long j;
X	long sa;
X	long result;
X	long zeros;
X
X	if (ALLOCATE && !a)
X	{
X		sprintf(str, "0");
X		return (1);
X	}
X	if (!div)
X	{
X		div = 10;
X		ldiv = 1;
X		while (div * 10 < RADIXROOT)
X		{
X			div *= 10;
X			ldiv++;
X		}
X	}
X	if (!out)
X		out = (verylong)calloc((size_t)(outsize = SIZE << 1), (size_t)SIZEOFLONG);
X	if ((sa = a[0]) < 0)
X	{
X		sa = -sa;
X		sprintf(str, "-");
X		j = 1;
X	}
X	else
X		j = 0;
X	if (ldiv * outsize < LOG10RAD * sa)
X	{
X		free((void*)out);
X		if (!(out = (verylong)calloc((size_t)(outsize = (LOG10RAD * sa) / ldiv + 2), (size_t)SIZEOFLONG))) {
X			zhalt("allocation failure in zswrite");
X			return (0);
X		}
X	}
X	zsetlength(&ca, sa, "in zswrite, local");
X	for (i = (ca[0] = sa); i; i--)
X		ca[i] = a[i];
X	i = -1;
X	do
X	{
X		if ((++i) >= outsize)
X		{
X			if (!(out = (verylong)realloc((void*)out, (size_t)((outsize += SIZE) * SIZEOFLONG))))
X			{
X				zhalt("reallocation failure in zswrite");
X				return (0);
X			}
X		}
X		out[i] = zsdiv(ca, div, &ca);
X	} while (ca[1] || ca[0] != 1);
X	sa = 0;
X	result = out[i];
X	do
X	{
X		sa++;
X	} while (result /= 10);
X	result = sa + i * ldiv;;
X	sprintf(str + j, "%ld", out[i--]);
X	j += sa;
X	for (; i >= 0; i--)
X	{
X		if (zeros = 10 * out[i])
X		{
X			while (zeros < div)
X			{
X				sprintf(str + j++, "0");
X				zeros *= 10;
X			}
X		}
X		else
X		{
X			for (zeros = ldiv - 1; zeros; zeros--)
X				sprintf(str + j++, "0");
X		}
X		sprintf(str + j, "%ld", out[i]);
X		sa += ldiv;
X		j = sa;
X	}
X	return (result);
X}
X
Xlong 
Xzbfwrite(
X	FILE *fn,
X	verylong a
X	)
X{
X	register long i;
X	static verylong zero = 0;
X
X	if (!zero)
X		zintoz((long) 0, &zero);
X	if (!a)
X	{
X		if ((long)fwrite((void*)zero, sizeof(long), 2, fn) < (long)2)
X			return (0);
X		return (1);
X	}
X	i = a[0];
X	if (i < 0)
X		i = -i + 1;
X	else
X		i++;
X	if ((long)fwrite((void*)a, sizeof(long), (size_t)i, fn) < i)
X		return (0);
X	return (1);
X}
X
Xlong 
Xzbfread(
X	FILE *fn,
X	verylong *a
X	)
X{
X	register long negative = 0;
X	long i;
X
X	if (feof(fn) || ferror(fn))
X		return (0);
X	if ((long)fread((void*)&i, sizeof(long), 1, fn) < (long)1)
X		return (0);
X	if (i < 0)
X	{
X		i = -i;
X		negative = 1;
X	}
X	zsetlength(a, i, "in zbfread, second argument");
X	if (negative)
X		(*a)[0] = -i;
X	else
X		(*a)[0] = i;
X	if (feof(fn) || ferror(fn))
X		return (0);
X	if ((long)fread((void*)&((*a)[1]), sizeof(long), (size_t)i, fn) < (long)i)
X		return (0);
X	return (1);
X}
X
Xlong
Xzfwrite_b(
X	FILE *fff,
X	verylong aa,
X	verylong out_base,
X	long sym_out
X	)
X{
X	register long i;
X	static long sl = 0;
X	static long ll = 0;
X	static long *s;
X	static verylong *l;
X	static verylong a;
X	long negative = 0;
X	long need;
X	zcopy(aa,&a);
X	if (zscompare(a,0)<0)
X	{
X		negative = 1;
X		znegate(&a);
X	}
X	if (zscompare(out_base,1) <= 0)
X		zhalt("output base < 2 in zfwrite_b");
X	if (zscompare(out_base,RADIX) < 0)
X	{
X		long b;
X		long cnt;
X		long si;
X		if (!zscompare(a,0))
X		{
X			fprintf(fff,"0");
X			return (0);
X		}
X		b = ztoint(out_base);
X		need = 5 + (long)zslog(a,b);
X		if (!sl)
X		{
X			if (!(s = (long*)calloc(need,sizeof(long))))
X			{
X				zhalt("allocation failure in zfwrite_b\n");
X				return (0);
X			}
X		} else if (need > sl)
X		{
X			if (!(s = (long*)realloc(s,need*sizeof(long))))
X			{
X				zhalt("reallocation failure in zfwrite_b\n");
X				return (0);
X			}
X		}
X		sl = need;
X		if (sym_out)
X			i = zstosymbas(a,b,s,&need);
X		else
X			i = zstobas(a,b,s,&need);
X		if (!i)
X		{
X			zhalt("zfwrite_b   BUG\n");
X			return (0);
X		}
X		if (sym_out && negative)
X			for (i=0;i<need;i++) s[i] = -s[i];
X		if (sym_out || (b>16))
X		{ /* in blocks */
X			long blockl;
X			if ((!sym_out) && negative)
X				fprintf(fff,"-");
X			zsadd(out_base,-1,&out_base);
X			blockl = (long)(zslog(out_base,10))+1;
X			zsadd(out_base,1,&out_base);
X			cnt = 0;
X			for (i=need-1;i>=0;i--)
X			{
X				si = s[i];
X				if (sym_out && b != 2 )
X				{
X					if (si<0)
X					{
X						fprintf(fff,"-");
X						si = -si;
X					} else
X						fprintf(fff," ");
X					cnt ++;
X				}
X				switch(blockl)
X				{
X					case 1:
X						fprintf(fff,"%01d",si);
X						break;
X					case 2:
X						fprintf(fff,"%02d",si);
X						break;
X					case 3:
X						fprintf(fff,"%03d",si);
X						break;
X					case 4:
X						fprintf(fff,"%04d",si);
X						break;
X					case 5:
X						fprintf(fff,"%05d",si);
X						break;
X					case 6:
X						fprintf(fff,"%06d",si);
X						break;
X					case 7:
X						fprintf(fff,"%07d",si);
X						break;
X					case 8:
X						fprintf(fff,"%08d",si);
X						break;
X					case 9:
X						fprintf(fff,"%09d",si);
X						break;
X					case 10:
X						fprintf(fff,"%010d",si);
X						break;
X				}
X				cnt += (blockl+1);
X				if (cnt > LINE - blockl)
X				{
X					if (i)
X					{
X						fprintf(fff,"\\\n");
X						cnt = 0;
X					} else
X						fprintf(fff,"\n");
X				} else if (i)
X					fprintf(fff," ");
X			}
X
X		} else 
X		{ /* without spaces */
X			if (negative)
X			{
X				fprintf(fff,"-");
X				cnt = 1;
X			} else 
X				cnt = 0;
X			for (i=need-1;i>=0;i--)
X			{
X				fprintf(fff,"%c",eulav((s[i])&15));
X				cnt ++;
X				if (cnt == LINE)
X				{
X					if (i)
X					{
X						fprintf(fff,"\\\n");
X						cnt = 0;
X					} else
X						fprintf(fff,"\n");
X				} else if (b==16)
X				{
X					if (i)
X					{
X						if (cnt==56)
X						{
X							fprintf(fff,"\\\n");
X							cnt = 0;
X						} else if ((cnt&7)==0)
X							fprintf(fff," ");
X					} else 
X						return (need);
X				}
X			}
X		}
X		return (need);
X	} else
X	{
X		long b;
X		long cnt;
X		long blocks;
X		if (!zscompare(a,0))
X		{
X			fprintf(fff,"0");
X			return (0);
X		}
X		need = 5 + (long)zlog(a,out_base);
X		if (!ll)
X		{
X			if (!(l = (verylong*)calloc(need,sizeof(verylong))))
X			{
X				zhalt("allocation failure in zfwrite_b\n");
X				return (0);
X			}
X			for (i=0;i<need;i++)
X				l[i] = 0;
X		} else if (need > ll)
X		{
X			if (!(l = (verylong*)realloc(l,need*sizeof(verylong))))
X			{
X				zhalt("reallocation failure in zfwrite_b\n");
X				return (0);
X			}
X			for (i=ll;i<need;i++)
X				l[i] = 0;
X		}
X		ll = need;
X		if (sym_out)
X			i = ztosymbas(a,out_base,l,&need);
X		else
X			i = ztobas(a,out_base,l,&need);
X		if (!i)
X		{
X			zhalt("zfwrite_b   BUG\n");
X			return (0);
X		}
X		if (sym_out && negative)
X			for (i=0;i<need;i++) znegate(&(l[i]));
X		if ((!sym_out) && negative)
X			fprintf(fff,"-");
X		zsadd(out_base,-1,&out_base);
X		blocks = LINE / ((long)(zslog(out_base,10))+1);
X		zsadd(out_base,1,&out_base);
X		if (blocks<=1)
X		{
X			for (i=need-1;i>=0;i--)
X			{
X				zfwrite(fff,l[i],LINE,"","");
X				if (i)
X					fprintf(fff," \\\n");
X			}
X		} else
X		{
X			cnt = 0;
X			for (i=need-1;i>=0;i--)
X			{
X				zfwrite(fff,l[i],LINE,"","");
X				cnt ++;
X				if (i)
X				{
X					fprintf(fff," ");
X					if (cnt == blocks)
X					{
X						fprintf(fff,"\\\n");
X						cnt = 0;
X					}
X				}
X			}
X		}
X		return (need);
X	}
X}
X
Xlong
Xzfwriteln_b(
X        FILE *fff,
X        verylong aa,
X        verylong out_base,
X        long sym_out
X        )
X{
X	long result = zfwrite_b(fff,aa,out_base,sym_out);
X	fprintf(fff,"\n");
X	return(result);
X}
X
Xlong
Xzfread_b(
X	FILE *fff,
X	verylong *a,
X	verylong in_base,
X	long sym_in
X	)
X{
X	static verylong digit = 0;
X	long negative = 0;
X	long reach = 0;
X	char y;
X	if ((zscompare(in_base,16) > 0) || (sym_in))
X	{
X		reach = 1;
X		zfread(fff,a);
X		if ((zscompare(*a,0)<0) && (!sym_in))
X		{
X			znegate(a);
X			negative = 1;
X		}
X		y=(char)fgetc(fff);
X		while (y != '\n')
X		{
X			while (y == ' ')
X				y=(char)fgetc(fff);
X			if (y != '\\')
X				ungetc((int)y,fff);
X			zfread(fff,&digit);
X			if (!sym_in) zabs(&digit);
X			zmulin(in_base,a);
X			zadd(*a,digit,a);
X			y=(char)fgetc(fff);
X		}
X		if (sym_in) return (1);
X	} else
X	{
X		register long short_in_base;
X		register long non_hex;
X		register long aftersl = 0;;
X		short_in_base = ztoint(in_base);
X		non_hex = (short_in_base != 16);
X		while ((y=(char)fgetc(fff)) == '\n');
X		if ((y == '-') || (y == '_'))
X		{
X			negative = 1;
X			y=(char)fgetc(fff);
X		}
X		zintoz(0,a);
X		while (strrchr("00123456789AaBbCcDdEeFf\\ ",y) != NULL)
X		{
X			if (non_hex && (y == ' ') && (!aftersl))
X				goto done;
X			if ((y != ' ') && (y != '\\'))
X			{
X				zsmul(*a,short_in_base,a);
X				zsadd(*a,value(y),a);
X				aftersl = 0;
X			}
X			if (y == '\\')
X			{
X				do
X					y=(char)fgetc(fff);
X				while (y != '\n');
X				aftersl = 1;
X			}
X			y=(char)fgetc(fff);
X		}
X		if (y != '\n')
X			ungetc((int)y,fff);
X		else
X			reach = 1;
X	}
Xdone:
X	if (negative)
X		znegate(a);
X	return reach;
X}
X
Xlong 
Xzsign(
X	verylong a
X	)
X{
X	if (ALLOCATE && !a)
X	{
X		return (0);
X	}
X	if (a[0] < 0)
X		return (-1);
X	if (a[0] > 1)
X		return (1);
X	if (a[1])
X		return (1);
X	return (0);
X}
X
Xvoid
Xzabs(
X	verylong *pa
X	)
X{
X	verylong a = *pa;
X
X	if (!a)
X		return;
X	if (a[0] < 0)
X		a[0] = (-a[0]);
X}
X
Xlong 
Xz2logs(
X	long a
X	)
X{
X	long i = 0;
X
X	if (a < 0)
X		a = -a;
X	while (a>=256)
X		i += 8, a >>= 8;
X	if (a >=16)
X		i += 4, a >>= 4;
X	if (a >= 4)
X		i += 2, a >>= 2;
X	if (a >= 2)
X		i += 2;
X	else if (a >= 1)
X		i++;
X	return (i);
X}
X
Xlong 
Xz2log(
X	verylong a
X	)
X{
X	register long la;
X
X	if (!a)
X		return (0);
X	la = (a[0] > 0 ? a[0] : -a[0]);
X	return ( NBITS * (la - 1) + z2logs(a[la]) );
X}
X
Xdouble 
Xzln(
X	verylong a
X	)
X{
X/*	extern double log(); */
X	register long sa;
X
X	if ((!a) || (a[0] <= 0))
X	{
X		zhalt("non-positive argument in zln");
X		return (0.0);
X	}
X	if ((sa = a[0]) == 1)
X		return (log((double) (a[1])));
X	return ((sa - 2) * NBITS * log((double) 2) +
X		log(((double)RADIX) * a[sa] + a[sa - 1]));
X}
X
Xdouble 
Xzlog(
X	verylong a,
X	verylong b
X	)
X{
X	return (zln(a) / zln(b));
X}
X
Xdouble 
Xzslog(
X	verylong a,
X	long b
X	)
X{
X/*	extern double log(); */
X
X	return (zln(a) / log((double)b));
X}
X
Xdouble 
Xzdlog(
X	verylong a,
X	double b
X	)
X{
X/*	extern double log(); */
X
X	return (zln(a) / log(b));
X}
X
Xlong
Xzscompare(
X	verylong a,
X	long b
X	)
X{
X	static verylong c = 0;
X
X	zintoz(b, &c);
X	return (zcompare(a, c));
X}
X
Xvoid
Xzswap(
X	verylong *a,
X	verylong *b
X	)
X{
X	register verylong c;
X
X	c = *a;
X	*a = *b;
X	*b = c;
X}
X
Xlong
Xziszero(
X	verylong a
X	)
X{
X	if (!a) return (1);
X	if (a[1]) return (0);
X	if (a[0]==1) return (1);
X	return (0);
X}
X
Xlong
Xzodd(
X	verylong a
X	)
X{
X	if (!a) return (0);
X	return (a[1]&1);
X}
X
Xlong
Xzweights(
X	long a
X	)
X{
X	register long i;
X	register long res = 0;
X	for (i=NBITS;i;i--) {
X		if (a & 1) res ++;
X		a >>= 1;
X	}
X	return (res);
X}
X
Xlong
Xzweight(
X        verylong a
X        )
X{
X	register long i;
X	register long res = 0;
X	if (!a) return (0);
X	i = a[0];
X	if (i<0) i = -i;
X	for (;i;i--)
X		res += zweights(a[i]);
X	return (res);
X}
X
Xvoid
Xznot(
X	verylong a,
X	verylong *b
X	)
X{
X	register long sa, i, m;
X	if (ziszero(a)) {
X		zintoz(1,b);
X		return;
X	}
X	zcopy(a,b);
X	sa = a[0];
X        if (sa<0) sa = -sa;
X        for (i=sa-1;i;i--)
X		(*b)[i] = ((~((*b)[i])) & RADIXM);
X	m = (RADIX >> 1);
X	i = RADIXM;
X	while (!(((*b)[sa])&m)) {
X		m >>= 1;
X		i >>= 1;
X	}
X	(*b)[sa] = ((~((*b)[sa])) & i);
X	while ((sa>1) && (!((*b)[sa])))
X		sa --;
X	if (((*b)[0] < 0) && ((*b)[1])) (*b)[0] = -sa;
X	else (*b)[0] = sa;
X}
X
Xvoid
Xzand(
X	verylong a,
X	verylong b,
X	verylong *cc
X	)
X
X{
X	verylong c = *cc;
X	register long sa;
X	register long sb;
X	register long sm;
X	if (ziszero(a) || ziszero(b)) {
X		zzero(cc);
X		return;
X	}
X	sa = a[0];
X	if (sa < 0) sa = -sa;
X	sb = b[0];
X	if (sb < 0) sb = -sb;
X	sm = (sa > sb ? sb : sa );
X	zsetlength(&c, sm, "in zand, third argument");
X	if (a == *cc) a = c;
X	if (b == *cc) b = c;
X	*cc = c;
X	for (sa = 1; sa <= sm; sa ++) 
X		c[sa] = a[sa] & b[sa];
X	while ((sm > 1) && (!(c[sm])))
X		sm --;
X	c[0] = sm;
X}
X
Xvoid
Xzxor(
X	verylong a,
X	verylong b,
X	verylong *cc
X	)
X{
X        verylong c = *cc;
X        register long sa;
X        register long sb;
X        register long sm;
X        register long la;
X        register long i;
X	if (ziszero(a)) {
X		zcopy(b,cc);
X		zabs(cc);
X		return;
X	}
X	if (ziszero(b)) {
X		zcopy(a,cc);
X		zabs(cc);
X		return;
X	}
X        sa = a[0];
X        if (sa < 0) sa = -sa;
X        sb = b[0];
X        if (sb < 0) sb = -sb;
X	if (sa > sb) {
X		la = sa;
X		sm = sb;
X	} else {
X		la = sb;
X		sm = sa;
X	}
X        zsetlength(&c, la, "in zxor, third argument");
X        if (a == *cc) a = c;
X        if (b == *cc) b = c;
X        *cc = c;
X        for (i = 1; i <= sm; i ++)
X                c[i] = a[i] ^ b[i];
X	if (sa > sb)
X		for (;i <= la; i++) c[i] = a[i];
X	else
X		for (;i <= la; i++) c[i] = b[i];
X        while ((la > 1) && (!(c[la])))
X                la --;
X        c[0] = la;
X}
X
Xvoid
Xzor(
X	verylong a,
X	verylong b,
X        verylong *cc
X        )
X{
X        verylong c = *cc;
X        register long sa;
X        register long sb;
X        register long sm;
X        register long la;
X        register long i;
X	if (ziszero(a)) {
X		zcopy(b,cc);
X		zabs(cc);
X		return;
X	}
X	if (ziszero(b)) {
X		zcopy(a,cc);
X		zabs(cc);
X		return;
X	}
X        sa = a[0];
X        if (sa < 0) sa = -sa;
X        sb = b[0];
X        if (sb < 0) sb = -sb;
X        if (sa > sb) {
X                la = sa;
X                sm = sb;
X        } else {
X                la = sb;
X                sm = sa;
X        }
X        zsetlength(&c, la, "in zor, third argument");
X        if (a == *cc) a = c;
X        if (b == *cc) b = c;
X        *cc = c;
X        for (i = 1; i <= sm; i ++)
X                c[i] = a[i] | b[i];
X        if (sa > sb)
X                for (;i <= la; i++) c[i] = a[i];
X        else
X                for (;i <= la; i++) c[i] = b[i];
X        c[0] = la;
X}
X
Xlong
Xzslowbits(
X	verylong a,
X	long b
X	)
X{
X	if (ziszero(a) || (b<=0))
X		return(0);
X	if (b>NBITS)
X		b = NBITS;
X	return (a[1]&((1<<b)-1));
X}
X
Xvoid
Xzlowbits(
X	verylong a,
X	long b,
X        verylong *cc
X        )
X{
X        verylong c = *cc;
X	register long bl;
X	register long wh;
X	register long sa;
X	if (ziszero(a) || (b<=0)) {
X		zintoz(0,cc);
X		return;
X	}
X        bl = (b/NBITS);
X        wh = b - NBITS*bl;
X        bl ++;
X	sa = a[0];
X	if (sa < 0) sa = -sa;
X	if (sa < bl) {
X		zcopy(a,cc);
X		zabs(cc);
X		return;
X	}
X        zsetlength(&c, bl, "in zlowbits, third argument");
X        if (a == *cc) a = c;
X        *cc = c;
X	for (sa=1;sa<bl;sa++)
X		c[sa] = a[sa];
X	c[bl] = a[bl]&((1<<wh)-1);
X	while ((bl>1) && (!c[bl]))
X		bl --;
X	c[0] = bl;
X}
X
Xlong
Xzshighbits(
X	verylong a,
X	long b
X	)
X{
X	long l;
X	static verylong aa=0;
X        if (ziszero(a) || (b<0))
X                return(0);
X        if (b>NBITS)
X                b = NBITS;
X	zcopy(a,&aa);
X	zabs(&aa);
X	l=z2log(aa);
X	if (l > b)
X		zrshift(aa,l-b,&aa);
X	return (ztoint(aa));
X}
X
Xvoid
Xzhighbits(
X	verylong a,
X	long b,
X	verylong *c
X	)
X{
X	long l;
X        if (ziszero(a) || (b<0)) {
X		zzero(c);
X		return;
X	}
X	zcopy(a,c);
X	zabs(c);
X	l = z2log(*c);
X	if (l > b)
X		zrshift(*c,l-b,c);
X}
X
Xvoid
Xzcat(
X	verylong a,
X	verylong b,
X	verylong *c
X	)
X{
X	register long signa = 0;
X	register long signb = 0;
X	static verylong aux = 0; 
X	if (ziszero(a)) {
X		zcopy(b,c);
X		return;
X	}
X	if (ziszero(b)) {
X		zlshift(a,1,c);
X		return;
X	}
X	if (a[0] < 0) {
X		signa = 1;
X		a[0] = -a[0];
X	}
X	if (b[0] < 0) {
X		signb = 1;
X		b[0] = -b[0];
X	}
X	zlshift(a,z2log(b),&aux);
X	zadd(aux,b,c);
X	if (signa && (a != *c)) a[0] = -a[0];
X	if (signb && (b != *c)) b[0] = -b[0];
X}
X
Xvoid
Xzgetbits(
X	verylong a,
X	long b,
X	long p,
X	verylong *c
X	)
X{
X	register long bl;
X	register long wh;
X	if (b<=0) {
X		zzero(c);
X		return;
X	}
X	if (p<0) p = -p;
X	zrshift(a,p,c);
X	zabs(c);
X	if (b>=z2log(*c)) return;
X	bl = (b-1)/NBITS +1;
X	for (wh=(*c)[0];wh>b;wh--) (*c)[wh] = 0;
X	(*c)[wh] &= ((1<<(b%NBITS))-1);
X	while ((wh>1) && (!((*c)[wh])))
X		wh --;
X	(*c)[0] = wh;
X}
X
Xlong
Xzbit(
X	verylong a,
X	long p
X	)
X{
X        register long bl;
X        register long wh;
X        register long sa;
X	if (ziszero(a)) return (0);
X	if (p < 0) p = -p;
X	bl = (p/NBITS);
X        wh = 1 << (p - NBITS*bl);
X	bl ++;
X        sa = a[0];
X        if (sa < 0) sa = -sa;
X        if (sa < bl) return (0);
X	if (a[bl] & wh) return (1);
X	return (0);
X}
X
Xlong
Xzsetbit(
X        verylong *a,
X        long b
X        )
X{
X	register long bl;
X	register long wh;
X	register long sa;
X	if (b<0) b = -b;
X	if (!(*a)) {
X		zintoz(1,a);
X		zlshift(*a,b,a);
X		return (0);
X	}
X	bl = (b/NBITS);
X	wh = 1 << (b - NBITS*bl);
X	bl ++;
X	sa = (*a)[0];
X	if (sa<0) sa = -sa;
X	if (sa >= bl) {
X		sa = (*a)[bl] & wh;
X		(*a)[bl] |= wh;
X		if (sa) return (1);
X		return (0);
X	} else {
X		zsetlength(a,bl,"in zsetbit, first argument");
X		sa ++;
X		for (;sa<=bl;sa++) (*a)[sa]=0;
X		if ((*a)[0] < 0)
X			(*a)[0] = -bl;
X		else (*a)[0] = bl;
X		(*a)[bl] |= wh;
X		return (0);
X	}
X}
X
Xlong
Xzswitchbit(
X        verylong *a,
X        long p
X        )
X{
X        register long bl;
X        register long wh;
X        register long sa;
X        if (p < 0) p = -p;
X        if (ziszero(*a)) {
X		zintoz(1,a);
X		zlshift(*a,p,a);
X		return (0);
X	}
X        bl = (p/NBITS);
X        wh = 1 << (p - NBITS*bl);
X        bl ++;
X        sa = (*a)[0];
X        if (sa < 0) sa = -sa;
X        if ((sa < bl) || (!((*a)[bl] & wh))) {
X		zsetbit(a,p);
X		return (0);
X	}
X	(*a)[bl] ^= wh;
X        while ((sa>1) && (!(*a)[sa]))
X		sa --;
X	if ((*a)[0] > 0) (*a)[0] = sa;
X	else (*a)[0] = -sa;
X        return (1);
X}
X
Xlong
Xzreverses(
X	long aa
X	)
X{
X	register long a = aa;
X	register long result = 1;
X	if (!a) return (0);
X	if (a < 0) a = -a;
X	while (!(a&1)) a >>= 1;
X	a >>= 1;
X	while (a) {
X		result <<= 1;
X		if (a & 1) result ++;
X		a >>= 1;
X	}
X	return (result);
X}
X
Xvoid
Xzreverse(
X	verylong a,
X	verylong *b
X	)
X{
X	register long sa;
X	register long i;
X	register long aux;
X	register long sh;
X	register long ma;
X	register long sr;
X	static verylong result = 0;
X	if (ziszero(a)) {
X		zzero(b);
X		return;
X	}
X	sa = a[0];
X	if (sa < 0) sa = -sa;
X	zsetlength(&result,sa,"in zreverse, local");
X	result[sa] = 0;
X	if (a[sa]&(RADIX>>1)) sr = sa;
X	else sr = sa-1;
X	for (i=1;i<=sr;i++) {
X		aux = a[sr+1-i];
X		if (!aux) 
X			result[i] = 0;
X		else {
X			ma = (RADIX>>1);
X			sh = 0;
X			while (!(aux&ma)) {
X				ma >>= 1;
X				sh ++;
X			}
X			result[i] = (zreverses(aux) << sh);
X		}
X	}
X	while ((sr>1) && (!(result[sr])))
X		sr --;
X	result[0] = sr;
X	if (!(a[sa]&(RADIX>>1))) {
X		zlshift(result,z2logs(a[sa]),&result);
X		zsadd(result,zreverses(a[sa]),&result);
X	}
X	zcopy(result,b);
X}
X
Xlong 
Xzjacobi(
X	verylong a,
X	verylong n
X	)
X{
X	long unit;
X	long i;
X	verylong temp = 0;
X
X	if (!n || zsign(n) <= 0)
X	{
X		zhalt("non-positive second argument in zjacobi");
X		return (0);
X	}
X	if (!a || !zsign(a))
X	{
X		return (0);
X	}
X	else if (a[0] == 1 && a[1] == 1)
X	{
X		return (1);
X	}
X	else if (n[0] == 1 && n[1] == 1)
X	{
X		return (1);
X	}
X	else if ((!(a[1] & 1)) && (!(n[1] & 1)))
X	{
X		return (0);
X	}
X	else if (!(n[1] & 1))
X	{
X		zcopy(n, &temp);
X		i = zmakeodd(&temp);
X		i = (i > 3 ? 8 : 1 << i);
X		if (a[1] % i != 1)
X			return (-1);
X		return (zjacobi(a, temp));
X	}
X	else if (a[0] < 0)
X	{
X		zcopy(a, &temp);
X		temp[0] = -temp[0];
X	/* check (n-1)/2 parity */
X		unit = (n[1] & 2 ? -1 : 1);
X		return (zjacobi(temp, n) * unit);
X	}
X	else if (!(a[1] & 1))
X	{
X	/* check (n*n-1)/8 parity */
X		i = n[1] & 7;
X		unit = (i == 3 || i == 5 ? -1 : 1);
X		zcopy(a, &temp);
X		zrshift(temp, (long) 1, &temp);
X		return (zjacobi(temp, n) * unit);
X	}
X	else
X	{
X	/* check ((a-1)*(n-1))/4 parity */
X		unit = ((a[1] & 2) && (n[1] & 2) ? -1 : 1);
X		zmod(n, a, &temp);	/* temp = n mod a */
X		return (zjacobi(temp, a) * unit);
X	}
X}
X
Xstatic void
Xzrootnewton(
X	verylong a,
X	verylong *b,
X	long n
X	)
X{
X	verylong c = 0;
X	verylong d = 0;
X
X	zintoz((long) 1, b);
X	zlshift(*b, (z2log(a) + n - 1) / n, b);
X	do
X	{
X		zsexp(*b, n - 1, &c);
X		zdiv(a, c, &c, &d);
X		zsub(*b, c, &c);
X		zsdiv(c, n, &c);
X		zsub(*b, c, b);
X	} while (zsign(c) > 0);
X	zsexp(*b, n, &c);
X	if (zcompare(c, a) > 0)
X		zsadd(*b, (long) (-1), b);
X}
X
Xvoid
Xzroot(
X	verylong a_in,
X	long n,
X	verylong *b
X	)
X{
X	static verylong a = 0;
X	long signa = zsign(a_in);
X
X	zcopy(a_in,&a);
X	if ((signa < 0) && (n & 1))
X		a[0] = -a[0];
X	if ((signa > 0 && n > 1) || (signa < 0 && (n & 1)))
X		zrootnewton(a, b, n);
X	else if (n == 1 || signa == 0 && n > 0)
X		zcopy(a, b);
X	else if (n == 0)
X	{
X		zhalt("dth root with d=0 in zroot");
X		return;
X	}
X	else if ((signa < 0) && (!(n & 1)))
X	{
X		zhalt("dth root with even d of negative number in zroot");
X		return;
X	}
X	else if (signa == 0 && n < 0)
X	{
X		zhalt("dth root with d<0 of zero in zroot");
X		return;
X	}
X	else
X		zintoz((long) 0, b);
X	if (signa < 0)
X	{
X		if (((*b)[1]) || ((*b)[0] > 1))
X			(*b)[0] = -(*b)[0];
X	}
X}
X
X
Xlong 
Xzjacobis(
X	long m,
X	long n
X	)
X{
X	register long m2;
X	register long m1;
X	register long jcbi = 1;
X
X	if (n < 0)
X		m2 = -n;
X	else
X		m2 = n;
X	if ((m2 & 1) == 0)
X	{
X		zhalt("even second argument in zjacobis");
X		return (0);
X	}
X
X	m1 = (m >= 0) ? (m % m2) : (m2 - ((-m) % m2));
X
X	while (1)
X	{
X		switch (m1 & 15)
X		{
X			case 0:
X				if (m1 == 0)
X					return ((m2 == 1) ? jcbi : 0);
X
X				m1 >>= 4;	/* Divide numerator by 16 */
X				continue;	/* continue while loop */
X
X			case 8:
X				m1 >>= 2;	/* Divide numerator by 4 */
X				continue;	/* continue while loop */
X
X			case 4:
X				m1 >>= 2;	/* Divide numerator by 4 */
X				break;
X
X			case 1:
X			case 5:
X			case 9:
X			case 13:
X				break;
X
X			case 2:
X			case 10:
X				m1 >>= 1;
X				if ((m2 & 7) == 3 || (m2 & 7) == 5)
X					jcbi = -jcbi;
X				break;
X
X			case 12:
X				m1 >>= 2;	/* Divide numerator by 4, */
X			/* fall through to 3 mod 4 cases */
X			case 3:
X			case 7:
X			case 11:
X			case 15:
X				if ((m2 & 2) != 0)	/* negate if  m1 == m2
X							 * == 3 mod 4 */
X					jcbi = -jcbi;
X				break;
X
X			case 6:
X			case 14:
X				m1 >>= 1;
X				if ((m2 & 4) != 0)
X					jcbi = -jcbi;
X				break;
X		}	/* end switch */
X
X		{	/* m1 and m2 are odd; invert them */
X		/* First divide m2 by 4, mod m1 */
X			register long m3;
X			m3 = ((((m2 + m1) & 3) == 0) ? m2 + m1 : m2 - m1) >> 2;
X			if (m3 >= m1)
X				m3 %= m1;
X			m2 = m1;
X			m1 = m3;
X		}
X	}	/* end while(1) */
X}
X
Xlong 
Xzprobprime(
X	verylong a,
X	long number_of_tests
X	)
X{
X	long result;
X	static verylong cofactor_a = 0;
X
X	if (!a || a[0] < 0)
X		return (0);
X	if ((a[0]==1) && (a[1]==2))
X		return (1);
X	if (!(a[1] & 1))
X		return (0);
X	if (a[0] == 1)
X	{
X		if ((a[1] == 3) || (a[1] == 5) || (a[1] == 7) || (a[1] == 11) )
X			return (1);
X		if (a[1] < 13) return (0);
X		result = zsqrts(a[1]);
X		if (ztridiv(a, &cofactor_a, (long) 3, result) <= result)
X			return (0);
X		return (1);
X	}
X	result = a[0] * 5 * NBITS;
X	if (ztridiv(a, &cofactor_a, (long) 3, result) <= result)
X		return (0);
X	if (zcomposite(&a, (long) 1, (long) 2))
X		return (0);
X	result = !zmcomposite(a, number_of_tests);
X /*
X  * if (!result) { printf("composite, but pseudo prime to the base 2:\n");
X  * zwriteln(a); }
X  */
X	return (result);
X}
X
Xvoid
Xzrandoml(
X	long bitlength,
X	verylong *a,
X	long (*generator) (long)
X	)
X{
X	register long i;
X	register long neg = 0;
X
X	if (bitlength == 0)
X	{
X		zintoz((long) 0, a);
X		return;
X	}
X	if (bitlength < 0)
X	{
X		bitlength = -bitlength;
X		neg = 1;
X	}
X	if (bitlength == 1)
X	{
X		zintoz((long) 1, a);
X		return;
X	}
X	zintoz((long) 1, a);
X	zlshift(*a, bitlength - 1, a);
X	for (i = 1; i < (*a)[0]; i++)
X		(*a)[i] = (*generator)((long)RADIX);
X	(*a)[i] += (*generator)((*a)[i]);
X	if (neg)
X		(*a)[0] = -(*a)[0];
X}
X
Xvoid
Xzrandomb(
X	verylong bnd,
X	verylong *a,
X	long (*generator) (long)
X	)
X{
X	static verylong big = 0;
X	static verylong bnd_minus_one = 0;
X
X	if (zscompare(bnd, (long) 1) <= 0)
X	{
X		zintoz((long) 0, a);
X		return;
X	}
X	if (zscompare(bnd, (long) 2) == 0)
X	{
X		zintoz((long) 1, a);
X		return;
X	}
X	zrandoml(z2log(bnd) + NBITS, &big, generator);
X	zsadd(bnd, (long) (-1), &bnd_minus_one);
X	zmod(big, bnd_minus_one, a);
X	zsadd(*a, (long) 1, a);
X}
X
Xlong 
Xzrandomprime(
X	long bitlength,
X	long nbtests,
X	verylong *a,
X	long (*generator) (long)
X	)
X{
X	static verylong t = 0;
X	static verylong bnd = 0;
X	register long adder = 2;
X	long three_mod_four = 0;
X
X	if (bitlength < 0)
X	{
X		bitlength = - bitlength;
X		three_mod_four = 1;
X		adder = 4;
X	}
X	if (bitlength < 2)
X		return (0);
X	if (bitlength == 2)
X	{
X		if (three_mod_four)
X			zintoz(3,a);
X		else
X		{
X			zintoz((*generator)((long) 2), a);
X			zsadd(*a, (long) 2, a);
X		}
X		return (1);
X	}
X	zintoz((long) 1, &bnd);
X	zlshift(bnd, bitlength, &bnd);
X	while (1)
X	{
X		if (three_mod_four)
X		{
X			zrandoml(bitlength - 2, &t,generator);
X			zlshift(t, (long) 2, a);
X			zsadd(*a, (long) 3, a);
X		}
X		else
X		{
X			zrandoml(bitlength - 1, &t,generator);
X			zlshift(t, (long) 1, a);
X			zsadd(*a, (long) 1, a);
X		}
X		while (zcompare(*a, bnd) < 0)
X		{
X			if (zprobprime(*a, nbtests))
X				return (1);
X			zsadd(*a, adder, a);
X		}
X	}
X}
X
Xlong
Xzrandomqprime(
X	long lp,
X	long lq,
X	long nbtests,
X	verylong *p,
X	verylong *q,
X	verylong *frac,
X	long (*generator) (long)
X	)
X{
X	register long oddq = 1;
X	register long cnt = 2 * lp;
X	static verylong tpsizem = 0;
X	static verylong tpsize = 0;
X	static verylong lown = 0;
X	static verylong upn = 0;
X	static verylong twoq = 0;
X
X	if (lq < 0)
X	{
X		lq = z2log(*q);
X		if ((!lq) || ((*q)[0] < 0))
X		{
X			zhalt("wrong q in zrandomqprime");
X			return (0);
X		}
X		if (((*q)[0] == 1) && ((*q)[1] == 1))
X		{
X			if (!(zrandomprime(lp, nbtests, p, generator)))
X				return (0);
X			zcopy(*p, frac);
X			return (1);
X		}
X		if (-lq >= lp)
X			return (0);
X	}
X	else if (!(zrandomprime(lq, nbtests, q, generator)))
X		return (0);
X
X	zintoz((long) 1, &tpsizem);
X	zlshift(tpsizem, lp - 1, &tpsizem);
X	zsadd(tpsizem, (long) (-1), &tpsizem);
X	zintoz((long) 1, &tpsize);
X	zlshift(tpsize, lp, &tpsize);
X	zsadd(tpsize, (long) (-1), &tpsize);
X
X	if ((*q)[1] & 1)
X		zlshift(*q, (long) 1, &twoq);
X	else
X	{
X		oddq = 0;
X		zcopy(*q, &twoq);
X	}
X	zdiv(tpsizem, twoq, &lown, frac);
X	zdiv(tpsize, twoq, &upn, frac);
X	zsub(upn, lown, &upn);
X	do
X	{
X		cnt--;
X		if (!cnt)
X		{
X			if (zscompare(upn, lp) <= 0)
X				return (0);
X		}
X		zrandomb(upn, p, generator);
X		zadd(lown, *p, frac);
X		zmul(twoq, *frac, p);
X		zsadd(*p, (long) 1, p);
X	} while (!zprobprime(*p, nbtests));
X	if (oddq)
X		zlshift(*frac, (long) 1, frac);
X	return (1);
X}
X
Xlong
Xzrandomfprime(
X	long length,
X	long nbtests,
X	verylong frac,
X	verylong *p,
X	verylong *q,
X	long (*generator) (long)
X	)
X{
X	register long pp;
X	register long qmp;
X	register long bound;
X	register long small_frac = 0;
X
X	static verylong aux = 0;
X
X	if ((zscompare(frac,2)<0) || (frac[1]&1))
X                return (0);
X
X	if (length < (NBITS>>1))
X	{
X        	do
X        	{
X                	if (!zrandomprime(length,nbtests,q,generator))
X                        	return (0);
X                	zmul(*q,frac,p);
X                	zsadd(*p,1,p);
X        	} while (!zprobprime(*p,nbtests));
X        	return (1);
X	}
X
X	if (zscompare(frac,RADIXROOT) <= 0)
X		small_frac = ztoint(frac);
X	if ((bound = (z2log(frac)+length)*5) > RADIXROOT)
X		bound = RADIXROOT;
X	for (;;)
X	{
X		zrandoml(length-1,q,generator);
X		zlshift(*q,1,q);
X		zsadd(*q,1,q);
X		zpstart();
X		while ((pp=zpnext()) <= bound) 
X		{
X			if (!(qmp = zsdiv(*q,pp,&aux)))
X				goto next_try;
X			if (small_frac)
X				qmp *= small_frac;
X			else
X				qmp *= zsdiv(frac,pp,&aux);
X			if (!((qmp+1)%pp))
X				goto next_try;
X		}
X		if (zcomposite(q,1,2))
X			goto next_try;
X		zmul(*q,frac,p);
X		zsadd(*p,1,p);
X		if (zcomposite(p,1,2) || zmcomposite(*q,nbtests)
X			|| zmcomposite(*p,nbtests))
X			goto next_try;
X		return (1);
X		next_try:;
X	}
X}
X
Xlong
Xzrandomgprime(
X	long lq,
X	long nbtests,
X	long small,
X	verylong *p,
X	verylong *q,
X	verylong *g,
X	long (*generator) (long)
X	)
X{
X	static verylong montone = 0;
X	static verylong aux = 0;
X	zintoz(2,&aux);
X	if (!zrandomfprime(lq,nbtests,aux,p,q,generator))
X		return 0;
X	zmkeep(*p);
X        zintoz((long)1, &montone);
X        ztom(montone,&montone);
X	if (small)
X		zcopy(montone,g);
X        for (;;)
X	{
X                if (small)
X			zaddmod(*g,montone,*p,g);
X		else
X			zrandomb(*p,g,generator);
X                zmontsq(*g,&aux);
X                if (zcompare(aux,montone))
X		{
X                        zmontexp_m_ary(*g,*q,&aux,0);
X                        if (zcompare(aux,montone))
X			{
X				zmtoz(*g,g);
X				zmback();
X				return 1;
X			}
X                }
X        }
X}
X
X#define	MAXM		3000000
X#define	PHASE1_BATCH	1
X#define	MAXTEP		31
X#define	MAXPWRP		12
X#define	MAXRP		(1 << MAXPWRP)
X#define	MINBOUND	100
X
Xstatic verylong ecm_tex[MAXTEP];
Xstatic verylong ecm_tey[MAXTEP];
Xstatic verylong ecm_coef[MAXRP];
Xstatic verylong ecm_power[MAXPWRP];
Xstatic verylong ecm_eval[MAXPWRP];
X
Xstatic long 
Xph1set(
X	verylong n,
X	verylong *rap,
X	verylong *alpha,
X	verylong *mu,
X	verylong *x,
X	verylong *f
X	)
X{
X /* Set up elliptic curve */
X /* if 0, success, */
X /* if 1, n factored, factor in f */
X	static verylong r = 0;
X	static verylong s = 0;
X	static verylong t1 = 0;
X	static verylong t2 = 0;
X	static verylong t3 = 0;
X	static verylong u = 0;
X	static verylong u2 = 0;
X	static verylong u3 = 0;
X	static verylong u4 = 0;
X
X	zrandomb(n,&s,zrandom);
X	zsqmod(s,n,&r);
X	zsmulmod(s,6,n,&s);
X	zsadd(r,6,&r);
X	if (zinv(r, n, &t1))
X	{
X		zcopy(t1, f);
X		return (1);
X	}
X	zmulmod(s, t1, n, &u);
X	zsqmod(u, n, &u2);
X	zmulmod(u, u2, n, &u3);
X	zsqmod(u2, n, &u4);
X	zsmul(u4, 3, &t1);
X	zmod(t1, n, &t1);
X	zsmul(u2, 6, &t2);
X	zmod(t2, n, &t2);
X	zaddmod(t1, t2, n, &t1);
X	zone(&t2);
X	zsubmod(t2, t1, n, &t1);
X	zsmul(u3, 4, &t2);
X	zmod(t2, n, &t2);
X	if (zinv(t2, n, &t3))
X	{
X		zcopy(t3, f);
X		return (1);
X	}
X	zmulmod(t1, t3, n, alpha);
X	zintoz(2, &t1);
X	zaddmod(*alpha, t1, n, &t1);
X	zintoz(4, &t2);
X	if (zinv(t2, n, &t3))
X	{
X		zcopy(t3, f);
X		return (1);
X	}
X	zmulmod(t1, t3, n, rap);
X	zsmul(u, 3, &t1);
X	zmod(t1, n, &t1);
X	zmulmod(t1, t3, n, x);
X	zintoz(3, &t1);
X	if (zinv(t1, n, &t2))
X	{
X		zcopy(t2, f);
X		return (1);
X	}
X	zmulmod(*alpha, t2, n, &t1);
X	zsubmod(n, t1, n, mu);
X	ztom(*rap, rap);
X	ztom(*alpha, alpha);
X	ztom(*mu, mu);
X	ztom(*x, x);
X	return (0);
X}
X
Xstatic long 
Xph1exp(
X	verylong n,
X	verylong *x,
X	verylong e,
X	verylong rap,
X	verylong *f
X	)
X{
X /* x = x^e on rap mod n */
X /* if 0, success */
X /* if 1, n factored, factor in f */
X	static verylong x1 = 0;
X	static verylong xn = 0;
X	static verylong xn1 = 0;
X	static verylong zzn = 0;
X	static verylong zn1 = 0;
X	static verylong s = 0;
X	static verylong s1 = 0;
X	static verylong d = 0;
X	static verylong d1 = 0;
X	static verylong t1 = 0;
X	static verylong t2 = 0;
X	static verylong t3 = 0;
X	static verylong t4 = 0;
X	static verylong longmask = 0;
X	register long mask;
X	register long maskcnt;
X	register long eatmaskcnt;
X	register long first = 1;
X
X	if (zscompare(e,1) <= 0)
X		return (0);
X	zcopy(*x, &x1);
X	zcopy(x1, &xn1);
X	zcopy(zr, &zn1);
X	zaddmod(xn1, zn1, n, &s1);
X	zsubmod(xn1, zn1, n, &d1);
X	zmontsq(s1, &t1);
X	zmontsq(d1, &t2);
X	zmontmul(t1, t2, &xn);
X	zsubmod(t1, t2, n, &t3);
X	zmontmul(rap, t3, &t4);
X	zaddmod(t2, t4, n, &t4);
X	zmontmul(t3, t4, &zzn);
X	zintoz(1,&longmask);
X	zlshift(longmask,z2log(e),&longmask);
X	zsub(longmask,e,&e);
X	maskcnt = longmask[0];
X	mask = longmask[maskcnt] >> 1;
X	if (!mask)
X	{
X		mask = (RADIX >> 2);
X		maskcnt --;
X	}
X	else
X	{
X		mask >>= 1;
X		if (!mask)
X		{
X			mask = (RADIX >> 1);
X			maskcnt --;
X		}
X	}
X	for (;maskcnt >0; maskcnt --)
X	{
X		if (maskcnt > e[0])
X			eatmaskcnt = 0;
X		else
X			eatmaskcnt = e[maskcnt];
X		while (mask)
X		{
X		  zaddmod(xn, zzn, n, &s);
X		  zsubmod(xn, zzn, n, &d);
X		  zaddmod(xn1, zn1, n, &s1);
X		  zsubmod(xn1, zn1, n, &d1);
X		  if (mask&eatmaskcnt)
X		  {
X			if ((maskcnt ) || ((!maskcnt) && (!(mask & 1))))
X			{
X				if (first)
X				{
X					zcopy(xn, &xn1);
X					zcopy(zzn, &zn1);
X				}
X				else
X				{
X					zmontsq(s1, &t1);
X					zmontsq(d1, &t2);
X					zmontmul(t1, t2, &xn1);
X					zsubmod(t1, t2, n, &t3);
X					zmontmul(rap, t3, &t4);
X					zaddmod(t2, t4, n, &t4);
X					zmontmul(t3, t4, &zn1);
X				}
X			}
X			zmontmul(d1, s, &t1);
X			zmontmul(d, s1, &t2);
X			zaddmod(t1, t2, n, &t3);
X			zmontsq(t3, &xn);
X			zsubmod(t1, t2, n, &t3);
X			zmontsq(t3, &t3);
X			zmontmul(x1, t3, &zzn);
X		  }
X		  else
X		  {
X			zmontsq(s, &t1);
X			zmontsq(d, &t2);
X			zmontmul(t1, t2, &xn);
X			zsubmod(t1, t2, n, &t3);
X			zmontmul(rap, t3, &t4);
X			zaddmod(t2, t4, n, &t4);
X			zmontmul(t3, t4, &zzn);
X			if ((maskcnt ) || ((!maskcnt) && (!(mask & 1))))
X			{
X				zmontmul(d1, s, &t1);
X				zmontmul(d, s1, &t2);
X				zaddmod(t1, t2, n, &t3);
X				zmontsq(t3, &xn1);
X				zsubmod(t1, t2, n, &t3);
X				zmontsq(t3, &t3);
X				zmontmul(x1, t3, &zn1);
X			}
X		  }
X		  mask >>= 1; first = 0;
X		}
X		mask = (RADIX >> 1);
X	}
X	if (zinv(zzn, n, f))
X		return (1);
X	zmontmul(*f, zrrr, x);
X	zmontmul(*x, xn, x);
X	return (0);
X}
X
Xstatic long 
Xph1(
X	verylong n,
X	verylong *x,
X	long m,
X	verylong rap,
X	verylong *f
X	)
X{
X /* x = x^B, B is product prime powers <=m	 */
X /* if 0, success				 */
X /* if 1, n factored, factor in f		 */
X	static verylong e = 0;
X	register long p;
X	register long q;
X	register long mp;
X	register long iter_cnt = 0;
X
X	zpstart2();
X	zintoz(1,&e);
X	while ((p = zpnext()) <= m)
X	{
X		mp = m / p;
X		q = p;
X		while (q <= mp)
X			q *= p;
X#if (PHASE1_BATCH == 1)
X		zintoz(q,&e);
X		if (ph1exp(n, x, e, rap, f) > 0)
X			return (1);
X	}
X#else
X
X		zsmul(e,q,&e);
X		iter_cnt ++;
X		if (iter_cnt == PHASE1_BATCH)
X		{
X			if (ph1exp(n, x, e, rap, f) > 0)
X				return (1);
X			iter_cnt = 0;
X			zintoz(1,&e);
X		}
X	}
X	if (iter_cnt)
X	{
X		if (ph1exp(n, x, e, rap, f) > 0)
X			return (1);
X	}
X#endif
X	return (0);
X}
X
Xstatic long 
Xph1toph2(
X	verylong n,
X	verylong *x,
X	verylong *y,
X	verylong *ra,
X	verylong alpha,
X	verylong mu,
X	verylong *f
X	)
X{
X /* tranform from first type of curve to second	 */
X /* x, alpha, mu input; x, y, ra output		 */
X /* if 0, success				 */
X /* if 1, n factored, factor in f		 */
X	static verylong beta = 0;
X	static verylong t = 0;
X
X	zaddmod(*x, alpha, n, &t);
X	zmontmul(*x, t, &t);
X	zmontmul(*x, t, &t);
X	zaddmod(*x, t, n, &beta);
X	if (zinv(beta, n, y))
X	{
X		zcopy(*y, f);
X		return (1);
X	}
X	zmontmul(*y, zrrr, y);
X	zsubmod(*x, mu, n, &t);
X	zmontmul(t, *y, x);
X	zmontmul(alpha, mu, &t);
X	zaddmod(t, zr, n, &t);
X	zmontmul(*y, t, &t);
X	zmontmul(*y, t, ra);
X	return (0);
X}
X
Xstatic long 
Xph2squ(
X	verylong n,
X	verylong x1s,
X	verylong y1s,
X	verylong *x2,
X	verylong *y2,
X	verylong ra,
X	verylong *f
X	)
X{
X /* (x2,y2)=(x1s,y1s)^2 on y^2=x^3+ra*x-b 	 */
X /* infinity if x1s[0] < 0			 */
X /* if 0, success				 */
X /* if 1, n factored, factor in f		 */
X	static verylong x1 = 0;
X	static verylong yy1 = 0;
X	static verylong t = 0;
X
X	zcopy(x1s, &x1);
X	zcopy(y1s, &yy1);
X	if (x1s[0] < 0)
X	{
X		(*x2)[0] = -1;
X		zzero(y2);
X		zzero(f);
X		return (1);
X	}
X	zaddmod(yy1, yy1, n, &t);
X	if (zinv(t, n, y2))
X	{
X		zcopy(*y2, f);
X		return (1);
X	}
X	zmontmul(*y2, zrrr, y2);
X	zmontsq(x1,x2);
X	zaddmod(*x2,*x2,n,&t);
X	zaddmod(*x2,t,n,&t);
X	zaddmod(t, ra, n, &t);
X	zmontmul(t, *y2, y2);
X	zmontsq(*y2, &t);
X	zsubmod(t, x1, n, &t);
X	zsubmod(t, x1, n, x2);
X	zsubmod(x1, *x2, n, &t);
X	zmontmul(*y2, t, &t);
X	zsubmod(t, yy1, n, y2);
X	return (0);
X}
X
Xstatic long 
Xph2mul(
X	verylong n,
X	verylong x1s,
X	verylong y1s,
X	verylong x2s,
X	verylong y2s,
X	verylong *x3,
X	verylong *y3,
X	verylong ra,
X	verylong *f
X	)
X{
X /* (x3,y3)=(x1s,y1s)*(x2s,y2s) on y^2=x^3+ra*x-b 	 */
X /* infinity if x1s[0] < 0 (or x2s[0]<0)			 */
X /* if 0, success					 */
X /* if 1, n factored, factor in f			 */
X	static verylong x1 = 0;
X	static verylong yy1 = 0;
X	static verylong x2 = 0;
X	static verylong y2 = 0;
X	static verylong t = 0;
X
X	zcopy(x1s, &x1);
X	zcopy(y1s, &yy1);
X	zcopy(x2s, &x2);
X	zcopy(y2s, &y2);
X	if (x1s[0] < 0)
X	{
X		zcopy(x2, x3);
X		zcopy(y2, y3);
X		zcopy(y2, f);
X		return (1);
X	}
X	if (x2s[0] < 0)
X	{
X		zcopy(x1, x3);
X		zcopy(yy1, y3);
X		zcopy(yy1, f);
X		return (1);
X	}
X	if (!(zcompare(x1, x2)))
X	{
X		zaddmod(yy1, y2, n, &t);
X		if (!t[1] && t[0] == 1)
X		{
X			(*x3)[0] = -1;
X			zzero(y3);
X			zzero(f);
X			return (1);
X		}
X		else
X			return (ph2squ(n, x1, yy1, x3, y3, ra, f));
X	}
X	else
X	{
X		zsubmod(x1, x2, n, &t);
X		if (zinv(t, n, y3))
X		{
X			zcopy(*y3, f);
X			return (1);
X		}
X		zmontmul(*y3, zrrr, y3);
X		zsubmod(yy1, y2, n, &t);
X		zmontmul(t, *y3, y3);
X		zmontsq(*y3, &t);
X		zsubmod(t, x1, n, &t);
X		zsubmod(t, x2, n, x3);
X		zsubmod(x1, *x3, n, &t);
X		zmontmul(*y3, t, &t);
X		zsubmod(t, yy1, n, y3);
X		return (0);
X	}
X}
X
Xstatic long 
Xph2exp(
X	verylong n,
X	verylong x1,
X	verylong yy1,
X	verylong *x2,
X	verylong *y2,
X	long e,
X	verylong ra,
X	verylong *f
X	)
X{
X /* (x2,y2)=(x1,yy1)^e on y^2=x^3+ra*x-b 	 */
X /* if 0, success			 */
X /* if 1, n factored, factor in f	 */
X	static verylong x1s = 0;
X	static verylong y1s = 0;
X	static verylong x3 = 0;
X	static verylong y3 = 0;
X	register long i;
X	register long two;
X	register long three;
X	long ee[NBITSH];
X
X	if (e == 1)
X	{
X		zcopy(x1, x2);
X		zcopy(yy1, y2);
X		return (0);
X	}
X	zcopy(x1, &x1s);
X	zcopy(yy1, &y1s);
X	if (e == 2)
X		return (ph2squ(n, x1s, y1s, x2, y2, ra, f));
X	i = -1;
X	two = 0;
X	three = 0;
X	while (e)
X	{
X		ee[++i] = (e & 3);
X		e >>= 2;
X		if (ee[i] == 3)
X			three = 1;
X	}
X	if (three || ee[i] == 2)
X	{
X		if (ph2squ(n, x1s, y1s, x2, y2, ra, f))
X			return (1);
X		two = 1;
X		if (three && ph2mul(n, x1s, y1s, *x2, *y2, &x3, &y3, ra, f))
X			return (1);
X	}
X	if (ee[i] == 3)
X	{
X		zcopy(x3, x2);
X		zcopy(y3, y2);
X	}
X	if (ee[i] == 1)
X	{
X		if (two)
X			two = 0;
X		else
X		{
X			two = 1;
X			zcopy(x1s, x2);
X			zcopy(y1s, y2);
X		}
X	}
X	for (i = i - 1; i >= 0; i--)
X	{
X		if (two)
X		{
X			if (ph2squ(n, *x2, *y2, x2, y2, ra, f))
X				return (1);
X		}
X		else
X			two = 1;
X		switch (ee[i])
X		{
X			case 0:
X				{
X					if (ph2squ(n, *x2, *y2, x2, y2, ra, f))
X						return (1);
X					break;
X				}
X			case 1:
X				{
X					if (ph2squ(n, *x2, *y2, x2, y2, ra, f))
X						return (1);
X					if (ph2mul(n, x1s, y1s, *x2, *y2, x2, y2, ra, f))
X						return (1);
X					break;
X				}
X			case 2:
X				{
X					if (ph2mul(n, x1s, y1s, *x2, *y2, x2, y2, ra, f))
X						return (1);
X					if (ph2squ(n, *x2, *y2, x2, y2, ra, f))
X						return (1);
X					break;
X				}
X			case 3:
X				{
X					if (ph2squ(n, *x2, *y2, x2, y2, ra, f))
X						return (1);
X					if (ph2mul(n, x3, y3, *x2, *y2, x2, y2, ra, f))
X						return (1);
X					break;
X				}
X		}
X	}
X	return (0);
X}
X
Xstatic long 
Xph2set(
X	verylong n,
X	verylong x,
X	verylong y,
X	long te,
X	verylong ra,
X	verylong *f
X	)
X{
X /* set up table for table size te	 */
X /* if 0, success			 */
X /* if 1, n factored, factor in f	 */
X	static verylong z = 0;
X	register long i;
X	register long j;
X	long expi;
X	long exp2;
X
X	expi = RADIX / (te + 2);
X
X	exp2 = 1 + zrandom(expi);
X	expi = 1 + zrandom(expi);
X	for (i = 0; i <= te; i++)
X	{
X		zcopy(x, &(ecm_tex[i]));
X		zcopy(y, &(ecm_tey[i]));
X		for (j = te; j > 0; j--)
X			if (ph2exp(n, ecm_tex[i], ecm_tey[i], &(ecm_tex[i]), &(ecm_tey[i]), expi, ra, f))
X				return (1);
X		expi += exp2;
X	}
X	for (j = 1; j <= te; j++)
X	{
X		for (i = te; i >= j; i--)
X		{
X			zsubmod(n, ecm_tey[i - 1], n, &z);
X			if (ph2mul(n, ecm_tex[i], ecm_tey[i], ecm_tex[i - 1], z, &(ecm_tex[i]), &(ecm_tey[i]), ra, f))
X				return (1);
X		}
X	}
X	return (0);
X}
X
Xstatic void
Xph2prec(
X	verylong n,
X	long n1,
X	long j
X	)
X{
X	static verylong mcn2j = 0;
X	static verylong t = 0;
X	register long i;
X	register long n2;
X	register long n2j;
X
X	if (n1 > 1)
X	{
X		n2 = ((n1 - 1) >> 1);
X		n2j = j + n2;
X		zaddmod(ecm_coef[n2j], znm, n, &(ecm_coef[n2j]));
X		zsubmod(n, ecm_coef[n2j], n, &mcn2j);
X		n2j ++;
X		for (i = 0; i < n2; i++)
X		{
X			zmontmul(ecm_coef[i + n2j], mcn2j, &t);
X			zaddmod(ecm_coef[i + j], t, n, &(ecm_coef[i + j]));
X		}
X		ph2prec(n, n2, n2j);
X		ph2prec(n, n2, j);
X	}
X}
X
Xstatic void
Xph2eval(
X	verylong n,
X	long ind,
X	long n1,
X	long j,
X	verylong *result
X	)
X{
X	register long n2;
X
X	if (n1 == 1)
X		zaddmod(ecm_coef[j], ecm_power[0], n, result);
X
X	else
X	{
X		n2 = ((n1 - 1) >> 1);
X		zaddmod(ecm_coef[n2 + j], ecm_power[ind], n, &(ecm_eval[ind]));
X		ph2eval(n, ind - 1, n2, n2 + j + 1, result);
X		zmontmul((ecm_eval[ind]), *result, &(ecm_eval[ind]));
X		ph2eval(n, ind - 1, n2, j, result);
X		zaddmod((ecm_eval[ind]), *result, n, result);
X	}
X}
X
Xstatic long 
Xph2(
X	verylong n,
X	verylong inx,
X	verylong iny,
X	long m,
X	long te,
X	verylong ra,
X	verylong *f
X	)
X{
X /* does second phase for m 		 */
X /* if 0, no factor found		 */
X /* if 1, n factored, factor in f	 */
X	static long non_initialized = 1;
X	static verylong x = 0;
X	static verylong y = 0;
X	static verylong x1 = 0;
X	static verylong x2 = 0;
X	static verylong prod = 0;
X	register long j;
X	register long k;
X	long r;
X	long r2;
X	long s;
X	long ind;
X
X	if (non_initialized)
X	{
X		for (j = 0; j < MAXRP; j++)
X			ecm_coef[j] = 0;
X		for (j = 0; j < MAXTEP; j++)
X			ecm_tex[j] = ecm_tey[j] = 0;
X		for (j = 0; j < MAXPWRP; j++)
X			ecm_power[j] = 0;
X		for (j = 0; j < MAXPWRP; j++)
X			ecm_eval[j] = 0;
X		non_initialized = 0;
X	}
X	zcopy(inx, &x);
X	zcopy(iny, &y);
X	if (ph2set(n, x, y, te, ra, f))
X		return (1);
X	if ((r = 100 * te) >= MAXRP)
X		r = MAXRP - 1;
X	r2 = 1;
X	ind = 0;
X	j = 3;
X	while (j <= r)
X	{
X		ind++;
X		r2 = j;
X		j <<= 1;
X		j++;
X	}
X	r = r2;
X	s = m / r;
X	while (r > 3 && s < 2 * r)
X	{
X		r >>= 1;
X		ind--;
X		s = m / r;
X	}
X	zcopy(zr, (&(ecm_coef[0])));
X	for (j = 1; j <= r; j++)
X	{
X		for (k = 0; k < te; k++)
X		{
X			if (ph2mul(n, ecm_tex[k], ecm_tey[k], ecm_tex[k + 1], ecm_tey[k + 1], &(ecm_tex[k]), &(ecm_tey[k]), ra, f))
X				return (1);
X		}
X		zsubmod(n, ecm_tex[0], n, &x1);
X		zcopy(ecm_coef[j - 1], &ecm_coef[j]);
X		for (k = j - 1; k > 0; k--)
X		{
X			zmontmul(x1, ecm_coef[k], &x2);
X			zaddmod(x2, ecm_coef[k - 1], n, &(ecm_coef[k]));
X		}
X		zmontmul(x1, ecm_coef[0], &(ecm_coef[0]));
X	}
X	ph2prec(n, r, (long) 0);
X	if (ph2set(n, x, y, te, ra, f))
X		return (1);
X	zone(&prod);
X	for (j = s; j > 0; j--)
X	{
X		for (k = 0; k < te; k++)
X		{
X			if (ph2mul(n, ecm_tex[k], ecm_tey[k], ecm_tex[k + 1], ecm_tey[k + 1], &(ecm_tex[k]), &(ecm_tey[k]), ra, f))
X				return (1);
X		}
X		zcopy(ecm_tex[0], &(ecm_power[0]));
X		for (k = 0; k < ind; k++)
X			zmontsq(ecm_power[k], &(ecm_power[k + 1]));
X		ph2eval(n, ind, r, (long) 0, &x2);
X		zmontmul(x2, prod, &prod);
X	}
X	if (zinv(prod, n, f))
X		return (1);
X	return (0);
X}
X
Xstatic void
Xmessage(
X	char *str,
X	double t
X	)
X{
X	printf("%s, %8.3lf seconds\n", str, gettime() - t);
X	fflush(stdout);
X}
X
Xstatic long 
Xtrial(
X	verylong n,
X	long m,
X	verylong *f,
X	long info
X	)
X{
X /* attempt to factor n, smoothness bound phase 1 is m	 */
X /* if 0, no success					 */
X /* if 1, n factored in setup, factor in f 		 */
X /* if 2, n factored in phase 1, factor in f 		 */
X /* if 3, n factored in ph1toph2, factor in f 		 */
X /* if 4, n factored in phase 1, factor in f 		 */
X	static verylong x = 0;
X	static verylong y = 0;
X	static verylong rap = 0;
X	static verylong alpha = 0;
X	static verylong mu = 0;
X	static verylong ra = 0;
X	static long te;
X	double tcnt = gettime();
X
X	if (ph1set(n, &rap, &alpha, &mu, &x, f) > 0)
X		return (1);
X	if (info >= 2)
X		message("   curve initialized", tcnt);
X	if (m > MAXM)
X		m = MAXM;
X	if (ph1(n, &x, m, rap, f))
X		return (2);
X	if (info >= 2)
X		message("   phase 1 completed", tcnt);
X	if (ph1toph2(n, &x, &y, &ra, alpha, mu, f))
X		return (3);
X /*
X  * if (m >= 4500000) te = 60; else
X	 */ if (m >= 1125000)
X		te = 30;
X	else if (m >= 720000)
X		te = 24;
X	else if (m >= 405000)
X		te = 18;
X	else if (m >= 180000)
X		te = 12;
X	else if (m >= 45000)
X		te = 6;
X	else if (m >= 11250)
X		te = 3;
X	else if (m >= 5000)
X		te = 2;
X	else
X		te = 1;
X	m *= 10;
X	if (ph2(n, x, y, m, te, ra, f))
X		return (4);
X	if (info >= 2)
X		message("   phase 2 completed", tcnt);
X	return (0);
X}
X
Xlong 
Xzecm(
X	verylong n,
X	verylong *f,
X	long uni,
X	long nb,
X	long bound,
X	long co,
X	long info
X	)
X{
X /* attempt to factor n, factor in f */
X /* uni is seed for random number generator */
X /* uni=0 means random generator started already */
X /* nb is number of curves */
X /* bound is bound for phase 1 of first curve */
X /* |co| is maximum number of probabilistic compositeness tests */
X /* info = 0: no timings or information */
X /* |info|=1: timing per curve, and some additional info */
X /* |info|>1: timing per phase and per curve */
X /* side effect: restart prime number generator, */
X /* zpnext() undefined after call */
X
X	static verylong q = 0;
X	static verylong r = 0;
X	register long i;
X	register long j;
X	double tcnt = gettime();
X
X	if (info < 0)
X		info = -info;
X	if (bound < MINBOUND)
X		bound = MINBOUND;
X	if (uni)
X	{
X		if (uni < 0)
X			uni = ((-uni) << 1);
X		else
X			uni = 2 * uni + 1;
X		zrstarts(uni + 1);
X	}
X	if (!n || n[0] < 0 || (n[0] == 1 && n[1] <= RADIXROOT))
X	{
X		if (info)
X			printf("wrong input to ecm\n");
X		return (0);
X	}
X	if (!(n[1] & 1))
X	{
X		zintoz(2, f);
X		if (info)
X		{
X			printf("ecm input is even\n");
X			fflush(stdout);
X		}
X		return (1);
X	}
X	if (info)
X	{
X		i = zfwrite(stdout, n, 70, "ecm on ", "");
X		printf("\n(%d digits)\n", i);
X	}
X	if (co)
X	{
X		if (co > 0)
X			co = -co;
X		zcopy(n, f);
X		i = zcomposite(f, co, 0);
X		if (!i)
X		{
X			if (info)
X				message("ecm input is probably prime", tcnt);
X			return (-1);
X		}
X		if (i == -2)
X		{
X			if (info)
X				message("factor found in compositeness test", tcnt);
X			return (1);
X		}
X		if (i == -1)
X		{
X			if (info)
X				message("factor in f^n-f", tcnt);
X			return (2);	/* factor in f^n-f */
X		}
X		if (i != 1)
X		{
X			zhalt("impossible return value of zcomposite in zecm   BUG");
X			return (0);
X		}
X		if (info >= 2)
X			message("ecm input composite, not a prime power", tcnt);
X	}
X	else if (info >= 2)
X	{
X		printf("ecm input assumed to be composite, and not a prime power\n");
X		fflush(stdout);
X	}
X
X	zone(f);
X	zmkeep(n);
X
X	for (i = nb; i > 0; i--)
X	{
X		if (info)
X			printf("%ld-th ecm trial with bound %ld\n", nb - i + 1, bound);
X		j = trial(n, bound, f, info);
X		bound = (long) (1.02 * bound);
X		if (j)
X		{
X			if (((*f)[0] == 1 && (*f)[1] <= 1) || !zcompare(n, *f))
X			{
X				if (info)
X					message("trivial factor in ecm", tcnt);
X				continue;
X			}
X			if (info)
X			{
X				printf("factor in ");
X				switch (j)
X				{
X					case 1:
X						{
X							message("curve set-up", tcnt);
X							break;
X						}
X					case 2:
X						{
X							message("phase 1", tcnt);
X							break;
X						}
X					case 3:
X						{
X							message("curve tranformation (phase 1 -> 2)", tcnt);
X							break;
X						}
X					case 4:
X						{
X							message("phase 2", tcnt);
X							break;
X						}
X				}
X			}
X			zdiv(n, *f, &q, &r);
X			if (r[1] || r[0] != 1)
X			{
X				zfwriteln(stderr,*f);
X				zhalt("this is a wrong factor, found in zecm   BUG");
X				zmback();
X				return (0);
X			}
X			zmback();
X			return (1);
X		}
X		if (info)
X		{
X			message("no success", tcnt);
X		}
X	}
X	if (info)
X		printf("done\n");
X	zmback();
X	return (0);
X}
X
X#endif
END_OF_FILE
if test 155766 -ne `wc -c <'src/lip.c'`; then
    echo shar: \"'src/lip.c'\" unpacked with wrong size!
fi
# end of 'src/lip.c'
fi
if test -f 'src/lip.h' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'src/lip.h'\"
else
echo shar: Extracting \"'src/lip.h'\" \(111545 characters\)
sed "s/^X//" >'src/lip.h' <<'END_OF_FILE'
X#if 0
X{
X
X                                 L I P 
X
X                 l o n g   i n t e g e r   p a c k a g e
X
X
X                    Copyright  Arjen K. Lenstra, 1989
X
XIntroduction
X============
XThis very long int package is supposed to be easy to use, portable, and
Xnot too slow.  It should also not be hard to make it fast by converting
Xa few macros to your favorite assembly code.
X
XThis version has an include file lip.h that defines all functions
Xand their arguments for ANSI C and contains:
X
Xtypedef long * verylong;
X
XOlder programs need not be changed to use this type.  It is added for
Xenhancing program readability.
X
XAs an example, the following program reads the decimal representation
Xof two arbitrary length signed integers a and b from stdin, computes
Xtheir product in c, and prints c in decimal on stdout, followed by a
Xnewline:
X
X        #include "lip.h"
X        main()
X        {
X        /* declare verylong ints a, b, c */
X                verylong a = 0;
X                verylong b = 0;
X                verylong c = 0;
X        /*********************************\
X        *   or declare them by
X        *       long *a = 0, *b = 0, *c = 0
X        \*********************************/
X                zread(&a);      /* read a from stdin */
X                zread(&b);      /* read b from stdin */
X                zmul(a, b, &c); /* multiply a anb b, put result in c */
X                zwriteln(c);    /* print c, followed by a newline */
X        }
X
XSample input:
X
X        7419043440758059956596 -60967068778579064460287972
X
Xwith output:
X
X        -452317331723962514217511611516823866219980863312
X
X(To run this example, first produce lip.o:
X
X	gcc -O -c lip.c
X
X where gcc is assumed to be your ansi-C compiler, and next
X
X	gcc -O -o example1 example1.c lip.o -lm
X
X to get the executable example1.)
X
XAs you can see, very long ints a, b, and c are declared simply by
X
X        verylong a = 0;
X        verylong b = 0;
X        verylong c = 0;
X
XIf a very long int is input to a function (like a and b in zmul(a, b, &c)),
Xjust give its name as argument. Long ints that get new values in
Xa function (like a in zread(&a), b in zread(&b), c in zmul(a, b, &c))
Xare given by their address, which means that they are preceded by a &
Xin the function call.
X
XAs a slightly more challenging example, the following program starts
Xthe random generator with a seed read from stdin, and attempts to
Xgenerate and print 5 probable primes of binary lengths 64, 80, 96, 112,
X128:
X
X        #include "lip.h"
X        main()
X        {
X                verylong seed = 0;
X                long  bl;
X                verylong p = 0;
X
X                zread(&seed);   /* get seed from stdin */
X                zrstart(seed);  /* start the random generator */
X                for (bl = 64; bl <= 128; bl += 16)
X                {
X                /* find prime of bl bits */
X                        if (zrandomprime(bl, 5, &p, zrandom))
X                        {
X                        /* refer to description below for the 5 */
X                                printf("%3d bits: ", bl);
X                                zwriteln(p);
X                        }
X                        else
X                                printf("couldn`t find a %3d bit prime\n", bl);
X                }
X        }
X
XSample input:
X
X        742434390077967024401578982882
X
Xwith output:
X
X         64 bits: 10967799917925347899
X         80 bits: 775542274364383616780191
X         96 bits: 58870772157780769086441178679
X        112 bits: 4677453209657821031486653700010011
X        128 bits: 295010382147229425545011630998398611849
X
X
XWARNING  for old users: some names have been changed.
X=======  If zxxx is a function operating on very long ints, then there
X         may be two variants of zxxx: zsxxx where one op the operands
X         is an ordinary long, and zxxxs where all operands are ordinary
X         longs. Compared to the previous version, the following
X         functions are affected (with some other name changes as well):
X
X                Old name        New name
X                --------        --------
X                ztimes2         z2mul
X                zdivide2        z2div
X                zsmulmod        zmulmods (there`s a new zsmulmod)
X                zsinv           zinvs
X                zsexp           zexpmods (there`s a new zsexp)
X                zexps           zsexp
X                zexpsmod        zsexpmod
X                zexp2mod        z2expmod
X                zssqrt          zsqrts
X                zsodinv         zinvodds
X                zsjacobi        zjacobis
X                zrstart         zrstarts (there`s a new zrstart)
X                zmont           zmontmul
X                zmexp           zmontexp
X                zmexp_m_ary     zmontexp_m_ary
X
X
X         Some arguments of some functions have changed:
X                zmulin          switched order
X                zmakeodd        *verylong (**long) instead of verylong (*long)
X                znegate         *verylong (**long) instead of verylong (*long)
X                zcomposite      *verylong (**long) instead of verylong (*long)
X
X
XOverview of available functions
X===============================
X
X  Basic arithmetic
X  ----------------
X        zstart, zsadd, zadd, zsub, zsubpos,
X        zsmul, zmul, zmulin, zmul_plain, zsq, zsqin, zsq_plain,
X        zsdiv, zdiv, zsmod, zmod
X
X  Shifting and bit manipulation
X  -----------------------------
X        z2mul, z2div, z2mod, zlshift, zrshift, zmakeodd,
X        zodd, znot, zand, zor, zxor, zslowbits, zlowbits,
X        zshighbits, zhighbits, zweights, zweight, zcat,
X	zbit, zgetbits, zsetbit, zswitchbit, zreverses,
X	zreverse
X
X  Comparison, signs, copying, logarithms
X  --------------------------------------
X        zscompare, zcompare, ziszero, zsign, zabs, znegate, zcopy, zswap
X        z2logs, z2log, zln, zslog, zlog, zdlog
X
X  Conversion
X  ----------
X        zzero, zone, zintoz, ztoint, zdoub,
X        zsbastoz, zbastoz, zstobas, ztobas, zstosymbas, ztosymbas
X
X  Non-modular exponentiation
X  --------------------------
X        zsexp, zexp, zsqrts, zsqrt, zroot
X
X  Modular arithmetic
X  ------------------
X        zaddmod, zsubmod, zmulmods, zsmulmod, zmulmod, zsqmod, zdivmod,
X        zinvmod, zexpmods, z2expmod, zsexpmod, zexpmod, zexpmod_m_ary,
X        zdefault_m, zexpmod_doub1, zexpmod_doub2, zexpmod_doub3, zexpmod_doub
X
X  Montgomery modular arithmetic
X  -----------------------------
X        zmstart, zmfree, ztom, zmtoz, zmontadd, zmontsub, zsmontmul, zmontmul,
X        zmontsq, zmontdiv, zmontinv, zmontexp, zmontexp_m_ary,
X        zmontexp_doub1, zmontexp_doub2, zmontexp_doub3, zmontexp_doub
X
X  Euclidean algorithms
X  --------------------
X        zgcd, zgcdeucl, zexteucl, zinvs, zinvodds, zinv, zchirem,
X        zjacobis, zjacobi
X
X  Random number generation
X  ------------------------
X        zrstarts, zrstart, zrandom, zrandoml, zrandomb,
X        zrandomprime, zrandomqprime, zrandomfprime, zrandomgprime
X
X  Small prime generation
X  ----------------------
X        zpstart, zpstart2, zpnext, zp
X
X  Compositeness testing and factorization
X  ---------------------------------------
X        zcomposite, zmcomposite, zprime, zprobprime,
X        ztridiv, zpollardrho, zecm
X
X  Allocation
X  ----------
X        zsetlength, zfree
X
X  Timing
X  ------
X        gettime, getutime, getstime, starttime, printtime
X
X  Input and output
X  ----------------
X          from       to        to      from     to      to       from    to
X          file      file      file     stdin  stdout  stdout    string  string
X       ------------------------------------------------------------------------
Xdecimal| zfread   zfwrite   zfwriteln  zread  zwrite  zwriteln  zsread  zswrite
Xhex    | zhfread  zhfwrite  zhfwriteln zhread zhwrite zhwriteln
Xnits   | zbfread  zbfwrite
Xanybase| zfread_b zfwrite_b zfwriteln_b
X
X
XRemarks
X=======
X- Unless stated otherwise, output can be input, but it`s not advised
X  to make output arguments identical (if there are more output
X  parameters).
X- Very long integers are represented by arrays of longs, in blocks
X  of NBITS bits (these blocks will be referred to as "nits").
X  A very long int (declared as  verylong a=0 ) either satisfies a==0,
X  in which case it is treated as zero, or it satisfies the following:
X
X        - |a[0]| is the significant length, say n, with n>0,
X          even for a with value zero.
X
X        - a[1], a[2], ..., a[n] are the nits, most significant nit
X          is a[n], with always 0<a[n]<RADIX and 0<=a[i]<RADIX for
X          i=1,2,...,n-1; here RADIX is (1<<NBITS).
X          Exception: a[n] can be zero if n=1, in which case a has
X          value zero.
X
X        - the sign of a[0] is the sign of a.
X
X        - a[-1] gives the amount of space currently allocated
X          for a. The functions check this location to see if
X          reallocation is needed.
X
X        - the values of a[n+1],...,a[a[-1]] are undefined, and
X          cannot be assumed to be zero.
X
X        - except a==0, the only other correct representation
X          of an a with value zero is: a[0]==1, a[1]==0. Negative
X          zero is not recognized.
X
X  Unless you know what you`re doing, don`t play with any of the a[i].
X
X- Because of the way verylongs are represented, local change (in
X  a routine) of a verylong parameter can affect the global value
X  of that parameter (and even destroy it entirely). As an example,
X  consider the following program:
X
X	#include "lip.h"
X
X	change_verylong(
X		verylong verylong_a
X		)
X	{
X		zwriteln(verylong_a);
X		zsadd(verylong_a,1,&verylong_a);
X		zwriteln(verylong_a);
X	}
X	
X	change_long(
X		long long_a
X		)
X	{
X		printf("%ld\n",long_a);
X		long_a ++;
X		printf("%ld\n",long_a);
X	}
X	
X	main () {
X		long a = 5;
X		verylong b = 0;
X		zintoz(5,&b);
X		change_long(a);
X		printf("%ld\n",a);
X		change_verylong(b);
X		zwriteln(b);
X	}
X
X  Ouput:
X	5
X	6
X	5
X	5
X	6
X	6
X
X  Although the parameter long_a gets a new value in change_long, this does
X  not affect the value of the argument a upon call: it is 5 before and after
X  the call. In change_verylong, however, the change made to the parameter
X  verylong_a affects the value of the argument b: it is 5 before, but 6
X  after the call. More dramatic things might happen too, if for instance
X  verylong_a gets reallocated in change_verylong and its original space
X  gets freed up....  To avoid these possible side-effects, either make
X  verylong_a a *verylong parameter (which should and does keep the local
X  changes made to it), or copy verylong_a to a local variable, and work
X  with the local variable:
X
X	better_change_verylong(
X                verylong verylong_a
X                )
X        {
X		static local_verylong_a = 0;
X		zcopy(verylong_a,&local_verylong_a);
X                zwriteln(local_verylong_a);
X                zsadd(local_verylong_a,1,&local_verylong_a);
X                zwriteln(local_verylong_a);
X        }
X
X
X- For those who know what the sizes of input and output
X  arguments are going to be, you can allocate variables by hand using
X  zsetlength, and make things slightly faster by using the
X  -DNO_ALLOCATE flag. Internal local variables will always be allocated
X  to the proper length, no matter what flags you use, and output
X  variables will also be reallocated if they didn`t get enough
X  space, irrespective of the -DNO_ALLOCATE flag.
X
X- To get an indication of what (re)allocations take place,
X  you can use the -DPRT_REALLOC flag. The indications will be
X  printed on stderr.
X
X- If an error is detected (division by zero, undefined Montgomery
X  modulus, undefined results, etc) a message is printed on stderr
X  and the program exits. If the -DNOHALT flag is used, the
X  program won`t exit, but values of variables might be undefined.
X  In the function descriptions below the possible error messages are
X  described. They are supposed to be self-explanatory, if not
X  a short explanation follows between (). If the message implies a bug
X  in LIP, please report it to lenstra@bellcore.com as soon as possible.
X  There is one message (`wrong call to zsmexp...BUG`) which can only be
X  generated by a wrong call to the internal (and undocumented) function
X  zsmexp; if you get this message you`re not using the original code.
X
X- If you don`t want to think about -DNO_ALLOCATE or -DPRT_REALLOC
X  flags, allocations, or other unpleasant matters, everything
X  should work fine, as long as you make sure that you declare
X  the very long ints as indicated above (i.e., verylong a=0, b=0, etc...),
X  and give them a & in a function call if they are output.
X  So, as you can see below, zadd(a, a, &a) adds a to a and puts
X  the result in a. On the other hand, zmul(a, b, &a) leads to
X  trouble, because input cannot be output in zmul; use
X  zmulin(b, &a) instead.
X
X- If you`re writing your own functions with local very long ints,
X  then it`s a good idea to declare the very long ints in frequently
X  called non-recursive functions as statics:
X
X        static verylong a = 0;
X        static verylong b = 0;
X        etc...
X
X  instead of
X
X        verylong a = 0;
X        verylong b = 0;
X        etc...
X
X  If static is used, reallocation of space for the local
X  very long ints is avoided in later calls to that same function,
X  unless one of the local very long ints needs more space than
X  in any of the previous calls: they always keep their longest
X  length. If you don`t use static, new space for the local
X  very long ints will be allocated for each new call to the
X  function, which is less efficient; also, you should use zfree
X  in that case at the end of the function, see below.
X
XAcknowledgments
X===============
X  Acknowledgments are due to many users for reporting bugs,
X  to Achim Flammenkamp for initializing the process of writing
X  this documentation, and to Bob Cain for converting to ansi.
X
XBefore you compile
X==================
X  You should make sure that some constants get the right value
X  for your environment. Here`s a short description of what you
X  need. If in doubt, don`t change it, and just try how it works.
X
X  Include Files Needed
X  --------------------
X        #include <stdio.h>
X        #include <math.h>
X        #include <malloc.h>
X        #include <signal.h>
X        #include <sys/time.h>
X        #include <sys/resource.h>
X        #include "lip.h"
X
X  Machine dependent constants 
X  --------------------------- 
X        Have a look at the constants with <------, and set them
X        to the right value for your environment
X
X        #define BYTEL           8       <------ Set this to the number of
X                                                bits in a byte. Usually it`s 8.
X
X        #define SIZEOFLONG      4       <------ Set this to the number of
X                                                bytes in a long, equals
X                                                sizeof(long).
X
X        #define NBITS           30      <------ Set this even, and as large as
X                                                possible such that
X                                                0 < NBITS < BYTEL*SIZEOFLONG.
X
X        #define RADIX           (1<<NBITS)      Don`t touch this, but it`s
X                                                good to know what the radix is.
X
X        #define MULT_CROSS      30              If in a call zmul(a, b, &c) the
X        #define SQUARE_CROSS    30              number of nits of a or b is
X        #define MAXDEPTH        20              less than MULT_CROSS, then a
X                                                and b are multiplied using the
X                plain quadratic multiplication function; if that`s not the
X                case Karatsuba will be applied, recursively, but to a
X                maximum of at most MAXDEPTH recursions. Same for zsq and
X                ZSQUARE_CROSS. The optimal values of these two cross-over
X                values depend on the machine you are going to use. The
X                choices above are not too far from optimal on a DEC5000;
X                on Sparcs the optimal values are somewhat smaller. You
X                can make MAXDEPTH as large as you like, as long as you
X                have enough memory.
X
X        #define SIZE            20      <------ Set this to anything such that
X                                                SIZE*NBITS>=BYTEL*SIZEOFLONG
X                SIZE is the default and minimum allocation size for very
X                long ints. Any value >= 2 should work. Depending on your
X                application smaller or larger values than 20 might lead
X                to more efficient code, because it either uses less space
X                (for a smaller SIZE), or it uses fewer allocations (for
X                a larger SIZE). If you`re not sure what SIZE to pick,
X                compile the package and your program with the -DPRT_REALLOC
X                flag, and run a representative example: the output will give
X                you an impression of the actual sizes that will be used, and
X                SIZE can be set accordingly before you compile again without
X                the -DPRT_REALLOC flag. If you don`t change it, it should work
X                fine.
X
X        #define LINE            68      <------ An approximate bound for
X                                                the maximal number of digits
X                per line of output. You might want to change this to 40
X                if you have an unusually narrow screen, or to 132 if you`re
X                still using one of these nice old lineprinters.
X                
X        #define BUFSIZE         2048            Input accepts at most
X                                                BUFSIZE characters per line.
X                This should not be too restrictive, because long lines
X                can easily be split into smaller lines, see below.
X
X        #define PRIMBND         5000            This enables you to
X                                                generate the primes
X                less than (2*PRIMBND+1)^2 using zpnext, see below.
X                For 5000 the last prime that can thus be generated is
X                100019977, which is the 5762535th prime. If this is not
X                enough, change it to any value such that two arrays
X                of longs of that length can still be allocated.
X}
X#endif
X
X#include <stdio.h>
X#include <math.h>
X
X/*The type of very long ints.*/
Xtypedef long * verylong;
X
X/******************************************************************************\
X*   Internal macros
X*
X*   Although the package is supposed to be portable, you might want to
X*   fine tune it to your particular machine to get better performance.
X*   The easiest way to do this is to replace the following macros, which
X*   you will find in the source code, by appropriate assembly language
X*   versions:
X*
X*   Also the C-code for zsubmul, zdiv21 and zmulmods can be made
X*   much faster in a similar way. I always simply used the macros
X*   or the C-code, and I get acceptable performance.
X\******************************************************************************/
X
X    void zaddmulp(verylong a, long b, long d, verylong t);
X        /******************************************************************\
X        * a = (a + t + b * d) % RADIX; and simultaneously
X        * t = (a + t + b * d) / RADIX;
X        \******************************************************************/
X
X    void zaddmulpsq(verylong a, long b, verylong t);
X        /******************************************************************\
X        * a = (a + b * b) % RADIX; and simultaneously
X        * t = (a + b * b) / RADIX;
X        \******************************************************************/
X
X    void zaddmulone(verylong a, verylong b);
X        /******************************************************************\
X        * a += b;
X        * a and b not at overlapping addresses
X        \******************************************************************/
X
X    void zaddmul(long d, verylong a, verylong b);
X        /******************************************************************\
X        * a += d * b;
X        * a and b not at overlapping addresses (except if d=1)
X        \******************************************************************/
X
X    void zaddmulsq(long d, verylong a, verylong b);
X        /******************************************************************\
X        * a += b[0] * b[1:d];
X        * a and b not at overlapping addresses (except if d=1)
X        \******************************************************************/
X
X    void zmmulp(verylong a, verylong b);
X        /******************************************************************\
X        * a[s:] += (a[s] * zminv) * b;
X        * to make a[s] == 0, where s and zminv are clear from
X        * the context, only in Montgomery multiplication
X        \******************************************************************/
X
X
X/******************************************************************************\
X*  Basic functions
X*  
X*  Addition, subtraction, multiplication, squaring, and
X*  division with remainder on signed arbitrary length integers.
X*  Multiplication and squaring use Karatsuba, if inputs large enough;
X*  see MULT_CROSS, SQUARE_CROSS, and MAXDEPTH as explained above.
X\******************************************************************************/
X
X    void zstart(void);
X        /******************************************************************\
X        * To initialize some global machine dependent values
X        * that have to be computed only once, call this only once per run.
X        * Everything still works fine if you forget to call zstart.
X        * If you`re sure that you`re not going to forget it, you may
X        * compile the package with the -DSTART flag and get slightly
X        * faster code.
X        *
X        * possible error message:
X        *   recompile with smaller NBITS
X        * result undefined if error occurs
X        \******************************************************************/
X
X    void zsadd(verylong a, long d, verylong *b);
X        /******************************************************************\
X        * *b = a + d;
X        * 
X        \******************************************************************/
X
X    void zadd(verylong a, verylong b, verylong *c);
X        /******************************************************************\
X        * *c = a + b;
X        * 
X        \******************************************************************/
X
X    void zsub(verylong a, verylong b, verylong *c);
X        /******************************************************************\
X        * *c = a - b;
X        * 
X        \******************************************************************/
X
X    void zsubpos(verylong a, verylong b, verylong *c);
X        /******************************************************************\
X        * *c = a - b;
X        * 
X        * only for a >= b >= 0
X        \******************************************************************/
X
X    void zsmul(verylong a, long d, verylong *b);
X        /******************************************************************\
X        * *b = d * a;
X        * 
X        \******************************************************************/
X
X    void zmul(verylong a, verylong b, verylong *c);
X        /******************************************************************\
X        * *c = a * b;
X        * 
X        * output cannot be input
X        \******************************************************************/
X
X    void zmulin(verylong a, verylong *b);
X        /******************************************************************\
X        * *b = a * b;
X        * 
X        * output cannot be input
X        \******************************************************************/
X
X    void zmul_plain(verylong a, verylong b, verylong *c);
X        /******************************************************************\
X        * *c = a * b;
X        * 
X        * output cannot be input, uses ordinary multiplication
X        \******************************************************************/
X
X    void zsq(verylong a, verylong *c);
X        /******************************************************************\
X        * *c = a * a;
X        * 
X        * output cannot be input
X        \******************************************************************/
X
X    void zsqin(verylong *a);
X        /******************************************************************\
X        * *a = a ^ 2;
X        * 
X        \******************************************************************/
X
X    void zsq_plain(verylong a, verylong *b);
X        /******************************************************************\
X        * *b = a ^ 2;
X        * 
X        * output cannot be input, uses ordinary squaring
X        \******************************************************************/
X
X    long zsdiv(verylong a, long d, verylong *b);
X        /******************************************************************\
X        * *b = a / d;
X        * return (a % d);
X        * 
X        * d != 0,
X        * always b * q + (a % d) == a and,
X        * unless b divides a, sign(a % d) == sign(d),
X        * calls zdiv if |d| >= RADIX
X        *
X        * possible error message:
X        *   division by zero in zsdiv
X        * result undefined if error occurs
X        \******************************************************************/
X
X    void zdiv(verylong a, verylong b, verylong *q, verylong *r);
X        /******************************************************************\
X        * *q = a / b;
X        * *r = a % b;
X        * 
X        * b != 0,
X        * always b * q + r == a,
X        * unless b divides a, sign(r) == sign(b)
X        *
X        * possible error message:
X        *   division by zero in zdiv
X        * result undefined if error occurs
X        \******************************************************************/
X
X    long zsmod(verylong a, long d);
X        /******************************************************************\
X        * return (a % d);
X        * 
X        * calls zsdiv
X        \******************************************************************/
X
X    void zmod(verylong a, verylong b, verylong *r);
X        /******************************************************************\
X        * *r = a % b;
X        * 
X        * unless b divides a, sign(r) == sign(b),
X        * slightly faster than zdiv
X        *
X        * possible error message:
X        *   division by zero in zmod
X        * result undefined if error occurs
X        \******************************************************************/
X
X
X/******************************************************************************\
X*  Shifting and bit manipulation
X*
X*  Left and right shifting, removal of all factors 2,
X*  parity test, logical and/(x)or, bit selections, weight,
X*  concatenation, bit-reverse
X*
X*  WARNING: The bit manipulation routines need to be debugged carefully
X\******************************************************************************/
X
X    void z2mul(verylong n, verylong *a);
X        /******************************************************************\
X        * *a = 2 * n;
X        * 
X        \******************************************************************/
X
X    long z2div(verylong n, verylong *a);
X        /******************************************************************\
X        * *a = n / 2; return (n % 2);
X        * 
X        * warning: for n == -2 * k + 1 (k > 0), z2div(n, &a)
X        * gives a = -k + 1, but zsdiv(a, 2, &b) gives b = -k,
X        * both return 1
X        \******************************************************************/
X
X    long z2mod(verylong n);
X        /******************************************************************\
X        * return (n % 2);
X        \******************************************************************/
X
X    void zlshift(verylong n, long k, verylong *a);
X        /******************************************************************\
X        * *a = 2 ^ k * n;
X        * 
X        * i.e., shifts left over k positions,
X        * calls zrshift(n, -k, a) if k < 0
X        \******************************************************************/
X
X    void zrshift(verylong n, long k, verylong *a);
X        /******************************************************************\
X        * *a = n / (2 ^ k);
X        * 
X        * i.e., shifts right over k positions,
X        * calls zlshift(n, -k, a) if k<0
X        \******************************************************************/
X    
X    long zmakeodd(verylong *n);
X        /******************************************************************\
X        * if (n != 0)
X        *     *n = m;
X        *     return (k such that n == 2 ^ k * m with m odd);
X        * else
X        *     return (-1);
X        \******************************************************************/
X
X    long zodd(verylong a);
X        /******************************************************************\
X        * returns 1 if a is odd, returns 0 if a is even
X        \******************************************************************/
X
X    void znot(verylong a, verylong *b);
X        /******************************************************************\
X        * if (a==0) then b gets 1,
X        * else b gets the negated bit pattern of the first z2log(|a|)
X        * bits of a, and b gets the same sign as a (unless b is zero)
X        \******************************************************************/
X
X    void zand(verylong a, verylong b, verylong *c);
X        /******************************************************************\
X        * c gets bit pattern `bits of |a|` and `bits of |b|`
X        \******************************************************************/
X
X    void zor(verylong a, verylong b, verylong *c);
X        /******************************************************************\
X        * c gets bit pattern `bits of |a|` inclusive or `bits of |b|`
X        \******************************************************************/
X
X    void zxor(verylong a, verylong b, verylong *c);
X        /******************************************************************\
X        * c gets bit pattern `bits of |a|` exclusive or `bits of |b|`
X        \******************************************************************/
X
X    long zslowbits(verylong a, long b);
X        /******************************************************************\
X	* returns b (or NBITS if b>NBITS) lowest order bits of |a|,
X        * 0 if b <= 0
X        \******************************************************************/
X
X    void zlowbits(verylong a, long b, verylong *c);
X        /******************************************************************\
X	* c gets b lowest order bits of |a|, c gets 0 if b <= 0
X        \******************************************************************/
X
X
X    long zshighbits(verylong a, long b);
X        /******************************************************************\
X        * returns b (or NBITS if b>NBITS) highest order bits of |a|,
X        * 0 if b <= 0
X        \******************************************************************/
X
X    void zhighbits(verylong a, long b, verylong *c);
X        /******************************************************************\
X        * c gets b highest order bits of |a|, c gets 0 if b <= 0
X        \******************************************************************/
X
X    long zweights(long a);
X        /******************************************************************\
X        * returns the number of one bits in |a| for |a| < RADIX
X        \******************************************************************/
X
X    long zweight(verylong a);
X        /******************************************************************\
X        * returns the number of one bits in |a|
X        \******************************************************************/
X
X    void zcat(verylong a, verylong b, verylong *c);
X        /******************************************************************\
X        * c gets the concatenation of bits of a followed by the bits of b
X        * (a becomes the high order and b the low order part of c)
X        \******************************************************************/
X
X    long zbit(verylong a, long p);
X        /******************************************************************\
X        * returns 1 if |p|th bit of |a| is on, 0 if |p|th bit of |a| is off
X        * p starts counting at 0
X        \******************************************************************/
X
X    void zgetbits(verylong a, long b, long p, verylong *c);
X        /******************************************************************\
X        * c gets the b bits of |a| starting at |a|`s |p|th bit
X        * c gets 0 if b <= 0
X        * p starts counting at 0
X        \******************************************************************/
X
X    long zsetbit(verylong *a, long p);
X        /******************************************************************\
X        * returns original value of |p|th bit of |a|, and replaces
X        * |p|th bit of a by 1 if it was zero
X        * p starts counting at 0
X        \******************************************************************/
X
X    long zswitchbit(verylong *a, long p);
X        /******************************************************************\
X        * returns original value of |p|th bit of |a|, and switches
X        * the value of |p|th bit of a
X        * p starts counting at 0
X        \******************************************************************/
X
X    long zreverses(long aa);
X        /******************************************************************\
X        * returns the bit reverse of |a| for |a| < RADIX
X        * i.e., zreverses(11001010) is 1010011
X        \******************************************************************/
X
X    void zreverse(verylong a, verylong *b);
X        /******************************************************************\
X        * b gets the bit reverse of |a|
X	* i.e., zintoz(11,&a); zlshift(a,100,&a); zreverse(a,&b);
X        *       produces b with value 13
X        \******************************************************************/
X
X
X/******************************************************************************\
X*  Comparison, signs, copying, logarithms
X\******************************************************************************/
X
X    long zscompare(verylong a, long b);
X        /******************************************************************\
X        * if (a > b)
X        *     return (1);
X        * if (a == b)
X        *     return (0);
X        * if (a < b)
X        *     return (-1);
X        \******************************************************************/
X
X    long zcompare(verylong a, verylong b);
X        /******************************************************************\
X        * if (a > b)
X        *     return (1);
X        * if (a == b)
X        *     return (0);
X        * if (a < b)
X        *     return (-1);
X        \******************************************************************/
X
X    long ziszero (verylong a);
X        /******************************************************************\
X        * if (a == 0)
X        *     return (1);
X        * if (a != 0)
X        *     return (0);
X        \******************************************************************/
X
X
X    long zsign(verylong a);
X        /******************************************************************\
X        * if (a > 0)
X        *     return (1);
X        * if (a == 0)
X        *     return (0);
X        * if (a < 0)
X        *     return (-1);
X        \******************************************************************/
X
X    void zabs(verylong *a);
X        /******************************************************************\
X        * *a = abs(a);
X        * 
X        \******************************************************************/
X
X    void znegate(verylong *a);
X        /******************************************************************\
X        * *a = -a;
X        * 
X        * has no effect on zero a
X        \******************************************************************/
X
X    void zcopy(verylong a, verylong *b);
X        /******************************************************************\
X        * *b = a;
X        \******************************************************************/
X
X    void zswap(verylong *a, verylong *b);
X        /******************************************************************\
X        * exchange values of *a and *b
X        \******************************************************************/
X
X    long z2logs(long a);
X        /******************************************************************\
X        * return (1 + log2(abs(a));
X        * 
X        * the number of binary bits to represent a,
X        * returns 0 if a = 0
X        \******************************************************************/
X
X    long z2log(verylong a);
X        /******************************************************************\
X        * return (1 + log2(abs(a));
X        * 
X        * the number of binary bits to represent a,
X        * returns 0 if a = 0
X        \******************************************************************/
X
X
X    double zln(verylong a);
X        /******************************************************************\
X        * return (approximation to the natural logarithm of a);
X        * 
X        * only for a >= 1
X        *
X        * possible error message:
X        *   non-positive argument in zln
X        * result undefined if error occurs
X        \******************************************************************/
X
X    double zslog(verylong a, long b);
X        /******************************************************************\
X        * return (approximation of the logarithm of a, base b);
X        * 
X        * only for a >= 1, b >= 2
X        \******************************************************************/
X
X    double zlog(verylong a, verylong b);
X        /******************************************************************\
X        * return (approximation of the logarithm of a, base b);
X        * 
X        * only for a >= 1, b >= 2
X        \******************************************************************/
X
X    double zdlog(verylong a, double b);
X        /******************************************************************\
X        * return (approximation of the logarithm of a, base b);
X        * 
X        * only for a >= 1, b > 1
X        \******************************************************************/
X
X
X/******************************************************************************\
X*  Conversion
X*
X*  Conversion between very long ints and ordinary longs or doubles.
X*  Conversion for very long ints to arbitrary basis and back.
X\******************************************************************************/
X        
X    void zzero(verylong *a);
X        /******************************************************************\
X        * *a = 0;
X        * 
X        * allocated zero
X        \******************************************************************/
X
X    void zone(verylong *a);
X        /******************************************************************\
X        * *a = 1;
X        * 
X        \******************************************************************/
X
X    void zintoz(long d, verylong *a);
X        /******************************************************************\
X        * *a = d;
X        * 
X        \******************************************************************/
X
X    long ztoint(verylong a);
X        /******************************************************************\
X        * return (attempted conversion of a`s value to long);
X        * no overflow check
X        * 
X        \******************************************************************/
X
X    double zdoub(verylong n);
X        /******************************************************************\
X        * return (attempted conversion of a`s value to double);
X        * 
X        * no overflow check
X        \******************************************************************/
X
X    void zsbastoz(long base, long row[], long len, verylong *n);
X        /******************************************************************\
X        * *n = sum from i = 0 to i = len - 1 of row[i] * base ^ i
X        * 
X        \******************************************************************/
X
X    void zbastoz(verylong base, verylong row[], long len, verylong *n);
X        /******************************************************************\
X        * *n = sum from i = 0 to i = len - 1 of row[i] * base ^ i
X        * 
X        \******************************************************************/
X
X    long zstobas(verylong n, long base, long row[], long *len);
X        /******************************************************************\
X        * sets *len to m and row[i] such that |n| equals
X        * sum from i = 0 to i = m - 1 of row[i] * |base| ^ i,
X        * with 0 <= row[i] < |base|
X        * returns 1 if m <= *len in input
X        * (which should on input be the length of row[])
X        * returns 0 if *len on input is too small to represent
X        * n in *len blocks or if |base| <= 1
X        \******************************************************************/
X
X    long ztobas(verylong n, verylong base, verylong row[], long *len);
X        /******************************************************************\
X        * same as zstobas, but with a very long int base
X        * 
X        \******************************************************************/
X
X    long zstosymbas(verylong n, long base, long row[], long *len);
X        /******************************************************************\
X        * same as zstobas, except that |row[i]| <= |base| / 2
X        * 
X        \******************************************************************/
X
X    long ztosymbas(verylong n, verylong base, verylong row[], long *len);
X        /******************************************************************\
X        * same as zstosymbas, but with a very long int base
X        * 
X        \******************************************************************/
X
X
X/******************************************************************************\
X*  Non-modular exponentiation 
X*
X*  Exponentiation, squareroots  and arbitrary roots.
X\******************************************************************************/
X
X    void zsexp(verylong a, long e, verylong *b);
X        /******************************************************************\
X        * *b = a ^ e;
X        * 
X        * arguments cannot be the same,
X        * e must be >= 0 if abs(a) != 1
X        \******************************************************************/
X
X    void zexp(verylong a, verylong e, verylong *b);
X        /******************************************************************\
X        * *b = a ^ e;
X        * 
X        * arguments cannot be the same,
X        * e must be >= 0 if abs(a) != 1,
X        * better be sure that you know what you`re 
X        * doing before you call this
X        *
X        * possible error message:
X        *   negative exponent in zexp
X        * result undefined if error occurs
X        \******************************************************************/
X
X    long zsqrts(long n);
X        /******************************************************************\
X        * if (n > 0)
X        *     return ([sqrt(n)]);
X        * else
X        *     return (0);
X        \******************************************************************/
X
X    long zsqrt(verylong n, verylong *r, verylong *dif);
X        /******************************************************************\
X        * *r = [sqrt(n)];
X        * *dif = n - r ^ 2;
X        * if (n perfect square)
X        *     return (1)
X        * else
X        *     return (0)
X        * 
X        * n must be >= 0
X        *
X        * possible error message:
X        *   negative argument in zsqrt
X        * result undefined if error occurs
X        \******************************************************************/
X
X    void zroot(verylong a, long n, verylong *b);
X        /******************************************************************\
X        * *b = nth root of a;
X        * 
X        * a must be >= 0 if n even, n >= 0 if a = 0,
X        * WARNING: buggy for large n, needs correction
X        *
X        * possible error message:
X        *   dth root with d=0 in zroot
X        *   dth root with even d of negative number in zroot
X        *   dth root with d<0 of zero in zroot
X        * result undefined if error occurs
X        \******************************************************************/
X
X
X/******************************************************************************\
X*  Modular arithmetic 
X*  
X*  Addition, subtraction, multiplication, squaring division, inversion,
X*  and exponentiation modulo a positive modulus n, where all operands
X*  (except for the exponent in exponentiation) and results are in the
X*  range [0, n-1]. For heavy computations modulo a fixed modulus it
X*  might be better to use Montgomery arithmetic.
X\******************************************************************************/
X
X    void zaddmod(verylong a, verylong b, verylong n, verylong *c);
X        /******************************************************************\
X        * *c = (a + b) % n;
X        * 
X        * with 0 <= a,b,c < n (and n positive)
X        *
X        * possible error message:
X        *   modulus zero in zaddmod
X        * result undefined if error occurs
X        \******************************************************************/
X
X    void zsubmod(verylong a, verylong b, verylong n, verylong *c);
X        /******************************************************************\
X        * *c = (a - b) % n;
X        * 
X        * with 0 <= a,b,c < n (and n positive)
X        *
X        * possible error message:
X        *   modulus zero in zsubmod
X        * result undefined if error occurs
X        \******************************************************************/
X
X    long zmulmods(long a, long b, long n);
X        /******************************************************************\
X        * return ((a * b) % n);
X        \******************************************************************/
X
X    void zsmulmod(verylong a, long b, verylong n, verylong *c);
X        /******************************************************************\
X        * *c = (a * b) % n;
X        * 
X        * with 0 <= a,b,c < n (and n positive)
X        *
X        * possible error message:
X        *   modulus zero in zsmulmod
X        * result undefined if error occurs
X        \******************************************************************/
X
X    void zmulmod(verylong a, verylong b, verylong n, verylong *c);
X        /******************************************************************\
X        * *c = (a * b) % n;
X        * 
X        * with 0 <= a,b,c < n (and n positive)
X        *
X        * possible error message:
X        *   modulus zero in zmulmod
X        * result undefined if error occurs
X        \******************************************************************/
X
X    void zsqmod(verylong a, verylong n, verylong *c);
X        /******************************************************************\
X        * *c = (a ^ 2) % n;
X        * 
X        * with 0 <= a,c < n (and n positive)
X        *
X        * possible error message:
X        *   modulus zero in zsqmod
X        * result undefined if error occurs
X        \******************************************************************/
X
X    void zdivmod(verylong a, verylong b, verylong n, verylong *c);
X        /******************************************************************\
X        * *c = (a / b) % n;
X        * 
X        * with 0 <= a,b,c < n (and n positive),
X        *
X        * possible error message:
X        *   modulus zero in zdivmod
X        *   divisor zero in zdivmod
X        *   undefined quotient in zdivmod
X        * result undefined if error occurs, except if the quotient
X        * is undefined, in which case a factor of n will be returned in c
X        * (of course, only if the -DNOHALT flag is used)
X        \******************************************************************/
X
X    void zinvmod(verylong a, verylong n, verylong *c);
X        /******************************************************************\
X        * *c = (1 / a) % n;
X        * 
X        * with 0 <= a,c < n (and n positive),
X        *
X        * possible error message:
X        *   modulus zero in zinvmod
X        *   division by zero in zinvmod
X        *   undefined inverse in zinvmod
X        * result undefined if error occurs, except if the inverse
X        * is undefined, in which case a factor of n will be returned in c
X        * (of course, only if the -DNOHALT flag is used)
X        \******************************************************************/
X
X    long zexpmods(long a, long e, long n);
X        /******************************************************************\
X        * return ((a ^ |e|) % n);
X        * 
X        \******************************************************************/
X
X    void zsexpmod(verylong a, long e, verylong n, verylong *b);
X        /******************************************************************\
X        * *b = (a ^ e) % n;
X        * 
X        * arguments cannot be the same (but a and b can be the same)
X        * (a^(-e)) and n coprime if e negative
X        \******************************************************************/
X
X    void z2expmod(verylong e, verylong n, verylong *b);
X        /******************************************************************\
X        * *b = (2 ^ e) % n;
X        * 
X        * arguments cannot be the same,
X        * (2^(-e)) and n coprime if e negative
X        *
X        * possible error message:
X        *   modulus zero in z2expmod
X        *   undefined quotient in z2expmod      (caused by negative exponent)
X        * result undefined if error occurs, except if the quotient
X        * is undefined, in which case a factor of n will be returned in b
X        * (of course, only if the -DNOHALT flag is used)
X        \******************************************************************/
X
X    void zexpmod(verylong a, verylong e, verylong n, verylong *b);
X        /******************************************************************\
X        * *b = (a ^ e) % n;
X        * 
X        * a and b can be the same, but both unequal
X        * to e and n, (a^(-e)) and n coprime if e negative
X        *
X        * possible error message:
X        *   modulus zero in zexpmod
X        *   undefined quotient in zexpmod       (caused by negative exponent)
X        * result undefined if error occurs, except if the quotient
X        * is undefined, in which case a factor of n will be returned in b
X        * (of course, only if the -DNOHALT flag is used)
X        \******************************************************************/
X
X    void zexpmod_m_ary(verylong a, verylong e, verylong n, verylong *b, long m);
X        /******************************************************************\
X        * b = (a ^ e) % n;
X        * 
X        * using m-ary method which is faster than
X        * zexpmod if a is not small, a and b can be the same, but both
X        * unequal to e and n, (a^(-e)) and n coprime if e negative,
X        * if m <= 1, default m will be used for m-ary method, if
X        * m >= NBITS, NBITS-1 will be used
X        *
X        * possible error message:
X        *   modulus zero in zexpmod_m_ary
X        *   undefined quotient in zexpmod_m_ary    (caused by negative exponent)
X        * result undefined if error occurs, except if the quotient
X        * is undefined, in which case a factor of n will be returned in b
X        * (of course, only if the -DNOHALT flag is used)
X        \******************************************************************/
X
X    long zdefault_m(long l);
X        /******************************************************************\
X        * return (default m for m-ary exponentiation);
X        \******************************************************************/
X
X    void zexpmod_doub1(verylong x1, verylong e1, verylong x2, verylong e2,
X                       verylong n, verylong *b);
X        /******************************************************************\
X        * b = ( x1 ^ e1) * (x2 ^ e2) % n;
X        *
X        * uses Shamir`s method, i.e., does the exponentiations simultaneously
X        * after precomputation of (x1*x2)%n, only for e1 and e2 non-negative,
X        * use if e1 and e2 approximately same size and small
X        *
X        * possible error message:
X        *  modulus zero in zexpmod_doub1
X        *  negative exponent in zexpmod_doub1     (if e1 or e2 negative)
X        * result undefined if error occurs
X        \******************************************************************/
X
X    void zexpmod_doub2(verylong x1, verylong e1, verylong x2, verylong e2,
X                       verylong n, verylong *b);
X        /******************************************************************\
X        * b = ( x1 ^ e1) * (x2 ^ e2) % n;
X        *
X        * uses Shamir`s method with sliding window of size 2 on exponents
X        * after precomputation of table of products (xi^i1)*(x2^i2)%n with
X        * 0<=i1,i2<=3 and i1 and i2 not both even, only for e1 and e2
X        * non-negative, use if e1 and e2 approximately same size and up to
X        * approximately 270 bits
X        *
X        * possible error message:
X        *  modulus zero in zexpmod_doub2
X        *  negative exponent in zexpmod_doub2     (if e1 or e2 negative)
X        * result undefined if error occurs
X        \******************************************************************/
X
X    void zexpmod_doub3(verylong x1, verylong e1, verylong x2, verylong e2,
X                       verylong n, verylong *b);
X        /******************************************************************\
X        * b = ( x1 ^ e1) * (x2 ^ e2) % n;
X        *
X        * uses Shamir`s method with sliding window of size 3 on exponents
X        * after precomputation of table of products (xi^i1)*(x2^i2)%n with
X        * 0<=i1,i2<=7 and i1 and i2 not both even, only for e1 and e2
X        * non-negative, use if e1 and e2 approximately same size and 
X        * larger than approximately 270 bits
X        *
X        * possible error message:
X        *  modulus zero in zexpmod_doub3
X        *  negative exponent in zexpmod_doub3     (if e1 or e2 negative)
X        * result undefined if error occurs
X        \******************************************************************/
X
X    void zexpmod_doub(verylong x1, verylong e1, verylong x2, verylong e2,
X                       verylong n, verylong *b);
X        /******************************************************************\
X        * b = ( x1 ^ e1) * (x2 ^ e2) % n;
X        *
X        * uses Shamir`s method with sliding window of size depending on
X        * maximal size of e1 or e2, using zexpmod_doub1, zexpmod_doub2,
X        * or zexpmod_doub3, only for e1 and e2 non-negative, use if e1
X        * and e2 approximately same size
X        *
X        * possible error message:
X        *  modulus zero in zexpmod_doub
X        *  negative exponent in zexpmod_doub     (if e1 or e2 negative)
X        * result undefined if error occurs
X        \******************************************************************/
X
X
X/******************************************************************************\
X*  Montgomery modular arithmetic
X*
X*  Modular multiplications can be done division free and therefore
X*  somewhat faster (about 20%), if the Montgomery representation is
X*  used. Converting to and from Montgomery representation takes one
X*  Montgomery multiplication each, so it only pays to use Montgomery
X*  representation if many multiplications have to be carried out
X*  modulo a fixed odd modulus.
X*
X*  To use Montgomery arithmetic, first initialize the modulus zn (use
X*  zmstart), and convert all operands to their Montgomery representation
X*  (ztom), but do Not convert exponents. Use the addition, subtraction,
X*  multiplication, squaring, division, inversion, and exponentiation
X*  functions (zmontxxx) below on the converted operands, just as you
X*  would use the ordinary modular functions (zxxxmod). The results can
X*  be converted back from Montgomery representation to ordinary numbers
X*  modulo zn using zmtoz. zmfree makes current Montgomery modulus undefined;
X*  this has no effect except that some routines that use Montgomery
X*  arithmetic (with a possibly different modulus) get slightly faster.
X*
X*  Once you have figured out how this works, you might want to try
X*  `mixed arithmetic` by using ordinary modular functions for operations
X*  on (non-converted) small constants and Montgomery numbers; zsmontmul
X*  might be helpful. See the source code of zmcomposite for an example.
X*
X*  For how it works, see P.L. Montgomery, Modular multiplication without
X*  trial division, Math. Comp, 44 (1985), 519--521.
X\******************************************************************************/
X
X    void zmstart(verylong n);
X        /******************************************************************\
X        * zn = n;
X        * 
X        * initializes the Montgomery modulus zn as n,
X        * only for odd positive n
X        *
X        * possible error message:
X        *   zero, or even, or negative modulus in zmstart
X        * result undefined if error occurs
X        \******************************************************************/
X
X    void zmfree();
X        /******************************************************************\
X        * Allows internal arithmetic to overwrite the current Montgomery
X        * modulus without restoring it
X        \******************************************************************/
X
X    void ztom(verylong a, verylong *ma);
X        /******************************************************************\
X        * *ma = montgomery(a);
X        * 
X        * converts the ordinary integer a modulo zn to its
X        * Montgomery representation ma
X        *
X        * possible error message:
X        *   undefined Montgomery modulus in ztom
X        * result undefined if error occurs
X        \******************************************************************/
X
X    void zmtoz(verylong ma, verylong *a);
X        /******************************************************************\
X        * *a = verylong(ma);
X        * 
X        * converts the Montgomery representation ma of a back to a
X        *
X        * possible error message:
X        *   undefined Montgomery modulus in zmtoz
X        * result undefined if error occurs
X        \******************************************************************/
X
X    void zmontadd(verylong ma, verylong mb, verylong *mc);
X        /******************************************************************\
X        * *mc = (ma + mb) % zn;
X        * 
X        * for Montgomery numbers ma and mb only
X        *
X        * possible error message:
X        *   undefined Montgomery modulus in zmontadd
X        * result undefined if error occurs
X        \******************************************************************/
X            
X    void zmontsub(verylong ma, verylong mb, verylong *mc);
X        /******************************************************************\
X        * *mc = (ma - mb) % zn;
X        * 
X        * for Montgomery numbers ma and mb only
X        *
X        * possible error message:
X        *   undefined Montgomery modulus in zmontsub
X        * result undefined if error occurs
X        \******************************************************************/
X
X    void zsmontmul(verylong ma, long d, verylong *mc);
X        /******************************************************************\
X        * mc = (d * ma) % zn;
X        * 
X        * for ordinary long d (Not converted), and Montgomery number ma
X        *
X        * possible error message:
X        *   undefined Montgomery modulus in zsmontmul
X        * result undefined if error occurs
X        \******************************************************************/
X
X    void zmontmul(verylong ma, verylong mb, verylong *mc);
X        /******************************************************************\
X        * *mc = (ma * mb) % zn;
X        * 
X        * for Montgomery numbers ma and mb only
X        *
X        * possible error message:
X        *   undefined Montgomery modulus in zmontmul
X        * result undefined if error occurs
X        \******************************************************************/
X
X    void zmontsq(verylong ma, verylong *mb);
X        /******************************************************************\
X        * *mb = (ma * ma) % zn;
X        * 
X        * for Montgomery number ma only
X        *
X        * possible error message:
X        *   undefined Montgomery modulus in zmontsq
X        * result undefined if error occurs
X        \******************************************************************/
X
X    void zmontdiv(verylong ma, verylong mb, verylong *mc);
X        /******************************************************************\
X        * *mc becomes the Montgomery quotient of ma and mb,
X        * i.e., the Montgomery representation mc of c = (a/b)%zn,
X        * where ma and mb are the Montgomery representations of a and b
X        * 
X        * for Montgomery numbers ma and mb only
X        *
X        * possible error message:
X        *   undefined Montgomery modulus in zmontdiv
X        *   division by zero in zmontdiv
X        *   undefined quotient in zmontdiv
X        * result undefined if error occurs, except if the quotient
X        * is undefined, in which case a factor of zn will be returned in mc
X        * (of course, only if the -DNOHALT flag is used)
X        \******************************************************************/
X
X    void zmontinv(verylong ma, verylong *mb);
X        /******************************************************************\
X        * *mb becomes the Montgomery inverse of ma
X        * i.e., the Montgomery representation mb of b = (1/a)%zn,
X        * where ma is the Montgomery representation of a
X        * 
X        * for Montgomery number ma only
X        *
X        * possible error message:
X        *   undefined Montgomery modulus in zmontinv
X        *   division by zero in zmontinv
X        *   undefined inverse in zmontinv
X        * result undefined if error occurs, except if the inverse
X        * is undefined, in which case a factor of zn will be returned in mb
X        * (of course, only if the -DNOHALT flag is used)
X        \******************************************************************/
X
X    void zmontexp(verylong ma, verylong e, verylong *mb);
X        /******************************************************************\
X        * *mb = (ma ^ e) % zn;
X        * 
X        * for Montgomery number ma and normal e
X        *
X        * possible error message:
X        *   undefined Montgomery modulus in zmontexp
X        *   undefined quotient in zmontexp      (caused by negative exponent)
X        * result undefined if error occurs, except if the quotient
X        * is undefined, in which case a factor of zn will be returned in mb
X        * (of course, only if the -DNOHALT flag is used)
X        \******************************************************************/
X
X    void zmontexp_m_ary(verylong ma, verylong e, verylong *mb, long m);
X        /******************************************************************\
X        * *mb = (ma ^ e) % zn;
X        * 
X        * for Montgomery number ma and normal e using m-ary
X        * exponentiation which is usually faster than zmontexp,
X        * if m <= 1, default m will be used (see above under Modular
X        * arithmetic), if m >= NBITS, NBITS-1 will be used
X        *
X        * possible error message:
X        *   undefined Montgomery modulus in zmontexp_m_ary
X        *   undefined quotient in zmontexp_m_ary   (caused by negative exponent)
X        * result undefined if error occurs, except if the quotient
X        * is undefined, in which case a factor of zn will be returned in mb
X        * (of course, only if the -DNOHALT flag is used)
X        \******************************************************************/
X
X    void zmontexp_doub1(verylong x1, verylong e1, verylong x2, verylong e2,
X                       verylong *b);
X        /******************************************************************\
X        * b = ( x1 ^ e1) * (x2 ^ e2) % zn;
X        *
X        * works as and use as zexpmod_doub1, but for Montgomery numbers x1
X        * and x2 (and normal e1 and e2) only
X        *
X        * possible error message:
X        *  undefined Montgomery modulus in zmontexp_doub1
X        *  negative exponent in zmontexp_doub1     (if e1 or e2 negative)
X        * result undefined if error occurs
X        \******************************************************************/
X
X    void zmontexp_doub2(verylong x1, verylong e1, verylong x2, verylong e2,
X                       verylong *b);
X        /******************************************************************\
X        * b = ( x1 ^ e1) * (x2 ^ e2) % zn;
X        *
X        * works as and use as zexpmod_doub2, but for Montgomery numbers x1
X        * and x2 (and normal e1 and e2) only
X        *
X        * possible error message:
X        *  undefined Montgomery modulus in zmontexp_doub2
X        *  negative exponent in zmontexp_doub2     (if e1 or e2 negative)
X        * result undefined if error occurs
X        \******************************************************************/
X
X    void zmontexp_doub3(verylong x1, verylong e1, verylong x2, verylong e2,
X                       verylong *b);
X        /******************************************************************\
X        * b = ( x1 ^ e1) * (x2 ^ e2) % zn;
X        *
X        * works as and use as zexpmod_doub3, but for Montgomery numbers x1
X        * and x2 (and normal e1 and e2) only
X        *
X        * possible error message:
X        *  undefined Montgomery modulus in zmontexp_doub3
X        *  negative exponent in zmontexp_doub3     (if e1 or e2 negative)
X        * result undefined if error occurs
X        \******************************************************************/
X
X    void zmontexp_doub(verylong x1, verylong e1, verylong x2, verylong e2,
X                       verylong *b);
X        /******************************************************************\
X        * b = ( x1 ^ e1) * (x2 ^ e2) % zn;
X        *
X        * for Montgomery numbers x1 and x2 (and normal e1 and e2),
X        * uses Shamir`s method with sliding window of size depending on
X        * maximal size of e1 or e2, using zmontexp_doub1, zmontexp_doub2,
X        * or zmontexp_doub3, only for e1 and e2 non-negative, use if e1
X        * and e2 approximately same size
X        *
X        * possible error message:
X        *  undefined Montgomery modulus in zmontexp_doub
X        *  negative exponent in zmontexp_doub     (if e1 or e2 negative)
X        * result undefined if error occurs
X        \******************************************************************/
X
X
X/******************************************************************************\
X*  Euclidean algorithms 
X*
X*  Greatest common divisors, extended Euclidean algorithm,
X*  modular inversion, Chinese remaindering, Jacobi symbols
X\******************************************************************************/
X
X    void zgcd(verylong m1, verylong m2, verylong *r);
X        /******************************************************************\
X        * *r = greatest common divisor of m1 and m2;
X        * 
X        * uses binary gcd algorithm
X        \******************************************************************/
X
X    void zgcdeucl(verylong m1, verylong m2, verylong *r);
X        /******************************************************************\
X        * *r = greatest common divisor of m1 and m2;
X        * 
X        * uses plain Euclidean algorithm (which might be
X        * faster than the binary method in special cases)
X        \******************************************************************/
X
X    void zexteucl(verylong a, verylong *xa,
X                 verylong b, verylong *xb,
X                 verylong *d);
X        /******************************************************************\
X        * *d = a * *xa + b * *xb = gcd(a, b);
X        * 
X        * sets *d, *xa and *xb given a and b,
X        * arguments cannot be the same,
X        * uses Lehmer`s trick
X        *
X        * possible error message:
X        *   zero argument(s) in zexteucl
X        *   non-zero remainder in zexteucl...BUG      (report this)
X        * result undefined if error occurs
X        \******************************************************************/
X
X    long zinvs(long n, long p);
X        /******************************************************************\
X        * return (x);
X        * 
X        * such that (x * abs(n)) % abs(p) = gcd(n, p)
X        \******************************************************************/
X
X    long zinvodds(long n, long p);
X        /******************************************************************\
X        * return (x);
X        * 
X        * such that x * n = 1 % p,
X        * only for n > 0 and odd p >= 3 with n and p coprime
X        *
X        * possible error message:
X        *   arguments not coprime in zinvodds
X        * result undefined if error occurs
X        \******************************************************************/
X
X    long zinv(verylong a, verylong b, verylong *c);
X        /******************************************************************\
X        * if (a and b coprime)
X        * {
X        *     *c = inv; 
X        *     return(0);
X        * }
X        * else
X        * {
X        *     *c = gcd(a, b);
X        *     return(1);
X        * }
X        * 
X        * where inv is such that (inv * a) % b == 1
X        * a,b > 0, uses Lehmer`s trick
X        *
X        * possible error message:
X        *   zero or negative argument(s) in zinv
X        * result undefined if error occurs
X        \******************************************************************/
X
X    void zchirem(verylong a, verylong ma,
X                 verylong b, verylong mb, verylong *d);
X        /******************************************************************\
X        * *d = chi;
X        * 
X        * such that chi == ma % a and chi == mb % b,
X        * a and b coprime if ma != mb, a and b positive,
X        * 0 <= d < a * b, unless a == b
X        *
X        * possible error message:
X        *   zero argument(s) in zchirem
X        *   zero or negative argument(s) in zchirem
X        *   same moduli with different remainders in zchirem
X        *   moduli not coprime in zchirem
X        * result undefined if error occurs
X        \******************************************************************/
X
X    long zjacobi(verylong a, verylong n);
X        /******************************************************************\
X        * for n>0 only:
X        *     return(Jacobi symbol J(a, n)), i.e.,
X        *           if (gcd(a, n) != 1)
X        *               return(0);
X        *           if (x exists such that x * x == a % n)
X        *               return(1);
X        *           else
X        *               return(-1);
X        *
X        * possible error message:
X        *   non-positive second argument in zjacobi
X        * result undefined if error occurs
X        \******************************************************************/
X
X    long zjacobis(long a, long n);
X        /******************************************************************\
X        * as above, accepts only odd positive n
X        *
X        * possible error message:
X        *   even second argument in zjacobis
X        * result undefined if error occurs
X        \******************************************************************/
X
X
X/******************************************************************************\
X*  Random number generation 
X*
X*  Because some algorithms need some more or less random bits every now
X*  and then, I`ve included a few functions to get random looking
X*  numbers.  These functions are only intended as a source of random
X*  numbers in probabilistic algorithms, like guessing a next base for a
X*  compositeness test, or guessing an elliptic curve for an ECM
X*  factoring attempt. They are not intended as a source of
X*  cryptographically secure random bits. There are some
X*  functions below that might have cryptographic applications (like
X*  zrandomprime and zrandomqprime). You should call them with
X*  your own favorite cryptographically strong random number generator
X*  if you are going to use these functions in real life. If security
X*  is not an important issue, you can call them with  zrandom
X\******************************************************************************/
X
X    void zrstarts(long s);
X        /******************************************************************\
X        * seed = s;
X        * 
X        * initialize the random number generator zrandom with seed = s,
X        * if you don`t call zrstarts or zrstart, or forget to call any
X        * of them seed gets initial value 7157891
X        *
X        * if you call zrstarts with s==0, zrandom will only produce zeroes
X        \******************************************************************/
X
X    void zrstart(verylong s);
X        /******************************************************************\
X        * seed = s;
X        * 
X        * initialize the random number generator zrandom with seed = s,
X        * if you don`t call zrstarts or zrstart, or forget to call any
X        * of them seed gets initial value 7157891
X        *
X        * if you call zrstart with s==0, zrandom will only produce zeroes
X        \******************************************************************/
X
X    long zrandom(long b);
X        /******************************************************************\
X        * seed = (seed * primitive_root) % prime;
X        * return (seed % b);
X        * 
X        * return value is supposed to be a more or less random integer in [0,b),
X        * if b <= 0 seed will not be changed, and 0 will be returned,
X        * prime == 2 ^ 107 - 1,
X        * primitive_root == (3 ^ 121) % prime
X        * 
X        * notice that zrandom returns only 0 if seed is initialized
X        * as zero, and that only the value of seed modulo prime is significant
X        \******************************************************************/
X
X    void zrandoml(long length, verylong *a, long (*generator) (long));
X        /******************************************************************\
X        * sets a to a random integer of precisely abs(length) bits,
X        * sign a becomes sign length
X        *
X        * generator is your own favorite random generator; a call to
X        * generator(b) (with b > 0) should return a more or less random
X        * number in the range [0,b); if cryptographic security is not
X        * an issue, you can use zrandom
X        *
X        * zrandoml works by first setting a = 2^{abs(length) -1}, replacing
X        * all nits of a except the most significant one by generator(RADIX),
X        * and finally a[a[0]] by a[a[0]] + generator(a[a[0]])
X        \******************************************************************/
X
X    void zrandomb(verylong bnd, verylong *a, long (*generator) (long));
X        /******************************************************************\
X        * sets a to a random integer in the open interval (0, bnd),
X        * a gets zero if interval is empty, generator as in zrandoml
X        *
X        * zrandomb works by first generating (using zrandoml) a random
X        * integer x of z2log(bnd)+NBITS bits, and by setting
X        * a = (x mod (bnd-1)) +1; the resulting a is therefore not
X        * entirely homogeneously distributed over (0,bnd)
X        \******************************************************************/
X
X    long zrandomprime(long length, long nbtests, verylong *a,
X                      long (*generator) (long));
X        /******************************************************************\
X        * if |length| >= 2, *a is set to a random probable prime
X        * of precisely |length| bits, if |length| < 2, *a is set to 0,
X        * if length < 0 then *a will be 3 modulo 4,
X        * uses nbtests + 1 probabilistic compositeness tests
X        * (see below, zprobprime), returns 1 if success, 0 if not
X        *
X        * zrandomprime works by picking odd number of right size, keep adding
X        * two until probably prime, or too large in which case pick again,
X        * and start adding again (in accordance with NIST DSS Appendix),
X        * generator as in zrandoml
X        \******************************************************************/
X            
X    long zrandomqprime(long lp, long lq, long nbtests,
X                       verylong *p, verylong *q, verylong *frac,
X                       long (*generator) (long));
X        /******************************************************************\
X        * if lq < 0 it expects a positive number (not necessarily prime) in q,
X        * if lq >= 0 it attempts to set q to a random probable prime
X        * having precisely lq bits, returns 0 if no success
X        * 
X        * attempts to set p to a random probable prime having precisely
X        * lp bits, such that q divides p-1, returns 0 if no success
X        * 
X        * sets frac to [p/q] and returns 1 if everything successful
X        * uses nbtests+1 probabilistic compositeness tests
X        * (see below, zprobprime)
X        * 
X        * q-search as in zrandomprime, p-search: keep generating random
X        * p of right size with q|p-1 until p is probably prime (in accordance
X        * with NIST DSS Appendix), so this only works if lp is substantially
X        * larger than |lq|, generator as in zrandoml
X        *
X        * possible error message:
X        *   wrong q in zrandomqprime
X        * result undefined if error occurs
X        \******************************************************************/
X
X    long zrandomfprime(long lq, long nbtests, verylong frac,
X                       verylong *p, verylong *q, long (*generator) (long));
X        /******************************************************************\
X        * returns 1 if successfully generated random probable primes q
X        * and p such that p = frac*q+1, where q has binary length lq,
X        * repeatedly uses zrandoml to set q until q and p prime
X        *
X        * returns 0 if frac<2 or frac odd, or if it couldn`t find a
X        * prime q of lq bits, generator as in zrandoml
X        \******************************************************************/
X
X    long zrandomgprime(long lq, long nbtests, long small,
X                       verylong *p, verylong *q, verylong *g,
X                       long (*generator) (long));
X        /******************************************************************\
X        * returns 1 if successfully generated random probable primes q
X        * and p such that p = 2*q+1, where q has binary length lq
X        * (p and q determined using zrandomfprime with frac == 2),
X        * and a generator g of the multiplicative group modulo p;
X        * if small==0 g will be randomly selected (using zrandomb), otherwise
X        * the smallest positive g will be selected, generator as in zrandoml
X        *
X        * returns 0 if it couldn`t find a prime q of lq bits
X        \******************************************************************/
X
X
X/******************************************************************************\
X*  Small prime generation
X*
X*  Functions to generate the sequence of primes up to (2*PRIMBND+1)^2
X\******************************************************************************/
X
X    long zpnext(void);
X        /******************************************************************\
X        * returns the next prime, starting at 2, unless zpstart
X        * has been called in which case the first subsequent zpnext call
X        * returns 3
X        * after returning the last prime before (2*PRIMBND+1)^2 it
X        * returns 2 on the next call
X        \******************************************************************/
X
X    void zpstart(void);
X        /******************************************************************\
X        * restart the prime generator in such a way
X        * that the next call to zpnext will produce 3
X        \******************************************************************/
X
X    void zpstart2(void);
X        /******************************************************************\
X        * restart the prime generator in such a way
X        * that the next call to zpnext will produce 2
X        \******************************************************************/
X
X    long zp(void);
X        /******************************************************************\
X        * returns 0 if zpnext has not been called yet,
X        * returns 0 if zpnext has not been called after the most recent
X        * zpstart or zpstart2, returns the prime previously returned
X        * by zpnext otherwise
X        \******************************************************************/
X
X
X/******************************************************************************\
X*  Compositeness testing and factorization 
X*
X*  Probabilistic compositeness tests (often referred to as
X*  pseudo-prime tests, or primality tests), trial division,
X*  Pollard rho factoring algorithm, elliptic curve factoring.
X\******************************************************************************/
X
X    long zcomposite(verylong *m, long t, long firstbase);
X        /******************************************************************\
X        * if t > 0, or t < 0 and ( m < 0, or m even, or m < sqrt(RADIX) ):
X        * 
X        * - returns 1 if m<2 or if zcomposite proved that m
X        *   is composite
X        * 
X        * - returns 0 if m>=2 and zcomposite could not prove
X        *   the compositeness of m after t compositeness tests,
X        *   which should happen with probability <=(1/4)^|t| for
X        *   composite m, so that one may safely assume that
X        *   m is prime if t is large enough (say, 5); in this
X        *   case m is called a `probable prime.`
X        *
X        * if t < 0 and m > 0, and m odd, and m > sqrt RADIX:
X        * 
X        * - returns 1 if zcomposite proved that m is composite
X        *   and not a prime power
X        * 
X        * - returns 0 if m>=2 and zcomposite could not prove
X        *   the compositeness of m after -t compositeness tests,
X        *   which should happen with probability <=(1/4)^(-t) for
X        *   composite m, so that one may safely assume that
X        *   m is prime if t is large enough
X        * 
X        * - returns -1 if zcomposite proved that m is composite
X        *   and not a prime power and furthermore an a has
X        *   been found satisfying gcd(a^m-a, m)=m; in this case
X        *   m is set to a, so that the original m can be factored
X        *   by looking at the factorization of a^m-a
X        * 
X        * - return -2 if zcomposite has found a factor of m,
X        *   in this case m is set to the factor
X        * 
X        * zcomposite uses (a stronger version of) Fermat`s little
X        * theorem to prove compositeness, which means, roughly speaking,
X        * that it attempts to find a number a for which a^m != a mod m,
X        * where a is called the `base;` if firstbase = 0, then at most
X        * |t| bases will be tried, all randomly selected in the range
X        * [3, RADIX-1]; if firstbase != 0, then firstbase will be the
X        * first base to be tried, the other |t|-1 will be randomly
X        * selected in the range [3, RADIX-1]; this allows you to select
X        * 2 as the first base (which allows faster arithmetic)
X        * 
X        * It`s better not to use zcomposite for large t to convince
X        * yourself of the m`s primality: use zcomposite with |t|=1, and
X        * if that returns 0, call zmcomposite to do as many additional
X        * tests as you like
X        \******************************************************************/
X
X    long zprime(verylong m, long t, long firstbase);
X        /******************************************************************\
X        * return (1 - zcomposite(&m, abs(t), firstbase));
X        \******************************************************************/
X
X    long zmcomposite(verylong m, long t);
X        /******************************************************************\
X        * like zcomposite but faster because it does mixed ordinary/
X        * Montgomery arithmetic, which makes it faster, only for t >= 0,
X        * only intended for many compositeness tests on a number that is
X        * already suspected to be prime
X        \******************************************************************/
X
X    long zprobprime(verylong n, long nbtests);
X        /******************************************************************\
X        * returns 1 if n is probably prime, 0 if n is composite,
X        * after at most nbtest + 1 probabilistic compositeness tests, and
X        * some trial division: uses ztridiv, if no factor found uses
X        * zcomposite with firstbase 2, if not yet proved composite uses
X        * zmcomposite with t = nbtests
X        * 
X        * faster than zprime for most randomly selected composites
X        * because small prime divisors are detected quickly
X        \******************************************************************/
X
X    long ztridiv(verylong n, verylong *cof, long b1, long b2);
X        /******************************************************************\
X        * attempts to find smallest prime divisor >= b1 and <= b2 of n,
X        * returns this divisor if found, or first prime >b2 if nothing found,
X        * if factor found, cof will be set to the cofactor (n divided by the
X        * factor), only intended for large n, and only for
X        * b2 <= (2 * PRIMBND + 1) ^ 2 so it is Not clever about trial
X        * division with primes > sqrt(n)
X        * 
X        * side effect: restarts small prime generator, zpnext()
X        * undefined after call
X        \******************************************************************/
X
X    long zpollardrho(verylong n, verylong *res, verylong *cof, long t);
X        /******************************************************************\
X        * returns 1 if Pollard rho found factor of n, puts factor
X        * in res and n/res in cof, res <= cof unless res=2, cof=1,
X        * for negative n sets res = -1, returns 0 if no factor found,
X        * does at most t (t=0 is infinity) iterations of main loop (see
X        * source code)
X        *
X        * possible error message:
X        *   wrong factor in zpollardrho...BUG     (report this)
X        * result undefined if error occurs
X        \******************************************************************/
X
X    long zecm(verylong n, verylong *f, long s, long curvebnd,
X              long phase1bnd, long nbtests, long info);
X        /******************************************************************\
X        * 
X        * returns 0 after unsuccessful attempt to factor n using
X        * curvebnd different randomly generated (starting from seed s, unless
X        * s=0 in which case zrandom simply continues or starts at default)
X        * elliptic curves with first phase bound phase1bnd (which increases
X        * by a factor of 1.02 for each new curve) or if n <= 2^(NBITS/2),
X        * returns 1 if the attempt was successful and puts the factor
X        * found in f, returns 2 (happens only in Very exceptional cases)
X        * if a factor of n can be found by looking at the factorization
X        * of f^n-f for the f on output, returns -1 if n found to be
X        * probably prime after nbtests probabilistic compositeness tests
X        * 
X        * runs silently with info=0, gives timing per curve
X        * and some additional information for info=1, and gives timings
X        * for phase 1 and phase 2 for info>1
X        * 
X        * side effects: restarts small prime generator, zpnext()
X        * undefined after call
X        *
X        * If you wish you can change the value of PHASE1_BATCH (default
X        * set at 1): phase one of ecm combines PHASE1_BATCH prime powers
X        * and does only one inversion per batch. Higher values of
X        * PHASE1_BATCH might save some run time.
X        * 
X        * if you find a factor of 38 or more decimal digits using
X        * zecm, I`d like to hear about it
X        \******************************************************************/
X
X
X/******************************************************************************\
X*  Allocation
X\******************************************************************************/
X
X    void zsetlength(verylong *v, long len, char *str);
X        /******************************************************************\
X        * (re)allocates enough space for v to hold an integer of
X        * absolute value < 2 ^ (len * RADIX), uses SIZE instead of len if
X        * len < SIZE, use this to allocate space by hand (if you`re using
X        * the -DNO_ALLOCATE flag), don`t use this unless you know what you`re
X        * doing
X        *
X        * possible error messages:
X        *   reallocation failed in zsetlength         (out of space)
X        *   allocation failed in zsetlength           (out of space)
X        *   negative size allocation in zsetlength    (*x==0 and len<0,
X        *          ====> BUG if you didn`t call zsetlength yourself)
X        * result undefined if error occurs
X        \******************************************************************/
X
X    void zfree(verylong *x);
X        /******************************************************************\
X        * frees the memory allocated for x, and sets x back to 0,
X        * where x is a very long int allocated by the functions internally
X        * or by zsetlength, use this to free the memory of very long ints
X        * which are local to functions (unless the locals are static)
X        \******************************************************************/
X
X
X/******************************************************************************\
X*  Timing 
X*
X*  Functions to get timing information
X\******************************************************************************/
X
X    double gettime(void);
X        /******************************************************************\
X        * returns (user time + system time) spent on current process
X        * in seconds, use this to get timing information about your_job
X        * as follows:
X        *     extern double gettime();
X        *     double time_it_took;
X        *     ...
X        *     time_it_took = gettime();
X        *     your_job(and_its_parameters);
X        *     time_it_took = gettime() - time_it_took;
X        *     printf("your_job took %12.8lf seconds\n", time_it_took);
X        *     ...
X        \******************************************************************/
X
X    double getutime(void);
X        /******************************************************************\
X        * same as gettime, but returns user time only
X        \******************************************************************/
X
X    double getstime(void);
X        /******************************************************************\
X        * same as gettime, but returns system time only
X        \******************************************************************/
X
X    void starttime(void);
X        /******************************************************************\
X        * (re)starts a timer, to be used with printtime()
X        \******************************************************************/
X
X    void printtime(FILE *f);
X        /******************************************************************\
X        * prints time spent since last call to starttime() to file f,
X        * followed by newline, and flushes f
X        \******************************************************************/
X
X
X/******************************************************************************\
X*  Input and output 
X*
X*       Functions for (hexa)decimal/direct in/output from/to files,
X*       stdin/stdout, or strings
X\******************************************************************************/
X
X    long zfread(FILE *f, verylong *a);
X        /******************************************************************\
X        * reads decimal representation of very long int from file f until
X        * first space into a; skips newlines, continues on next line only if
X        * line ends with a \, accepts sign on first line, returns 1 if success,
X        * 0 if not, may use _ instead of -
X        \******************************************************************/
X
X    long zfwrite(FILE *f, verylong a, long linelen, char *str1, char *str2);
X        /******************************************************************\
X        * writes decimal representation of a to file f with at most
X        * approximately linelen char per line, \ indicates continuation on
X        * next line, first line begins with str1, each consecutive line
X        * with str2, returns decimal length of a
X        *
X        * possible error message:
X        *   allocation failure in zfwrite      (a too large to print)
X        *   reallocation failure in zfwrite    (a too large to print)
X        * result undefined if error occurs
X        \******************************************************************/
X
X    long zfwriteln(FILE *f, verylong a);
X        /******************************************************************\
X        * writes decimal representation of a to file f followed by a newline,
X        * format as in zfwrite(f,a,LINE,"",""), returns decimal length a
X        \******************************************************************/
X
X    long zread(verylong *a);
X        /******************************************************************\
X        * reads decimal representation of very long int from standard input
X        * into a, format as in zfread, returns 1 if success, 0 if not
X        \******************************************************************/
X
X    long zwrite(verylong a);
X        /******************************************************************\
X        * writes decimal representation of a to standard output,
X        * format as in zfwrite, returns decimal length a
X        \******************************************************************/
X
X    long zwriteln(verylong a);
X        /******************************************************************\
X        * writes decimal representation of a to standard output
X        * followed by a newline, format as in zfwrite, returns decimal
X        * length a
X        \******************************************************************/
X
X    long zsread(char *str, verylong *a);
X        /******************************************************************\
X        * reads decimal representation of very long int from string str
X        * into a, returns 1 if success, 0 if not
X        \******************************************************************/
X
X    long zswrite(char *str, verylong a);
X        /******************************************************************\
X        * writes decimal representation of a to string str, returns
X        * decimal length a
X        *
X        * possible error message:
X        *   allocation failure in zfwrite      (a too large to print)
X        *   reallocation failure in zfwrite    (a too large to print)
X        * result undefined if error occurs
X        \******************************************************************/
X
X    void zhfread(FILE *f, verylong *a);
X        /******************************************************************\
X        * reads hexadecimal representation of very long int from file f
X        * into a, skips newlines and spaces, but continues on next line only if
X        * line ends with a \, end of input indicated by a newline, accepts
X        * sign on first line, accepts both lower and upper case a, b, c, d, e, f
X        * for digits 10 thru 15
X        \******************************************************************/
X
X    void zhfwrite(FILE *f, verylong x);
X        /******************************************************************\
X        * writes hexadecimal representation of x to file f in blocks
X        * of 8 characters separated by spaces, at most seven blocks per line,
X        * \ indicates continuation on next line, the digits 10 thru 15 are
X        * represented by A, B, C, D, E, F, unless package compiled with -DLOWER
X        * flag, in which case 10 thru 15 are represented by a, b, c, d, e, f
X        \******************************************************************/
X
X    void zhfwriteln(FILE *f, verylong x);
X        /******************************************************************\
X        * writes hexadecimal representation of x to file f followed by a
X        * newline, format as in zhfwrite
X        \******************************************************************/
X
X    void zhread(verylong *a);
X        /******************************************************************\
X        * reads hexadecimal representation of very long int from stdin
X        * into a, format as in zhfread
X        \******************************************************************/
X
X    void zhwrite(verylong a);
X        /******************************************************************\
X        * writes hexadecimal representation of a to stdout, format
X        * as in zhfwrite
X        \******************************************************************/
X
X    void zhwriteln(verylong a);
X        /******************************************************************\
X        * writes hexadecimal representation of a to stdout followed
X        * by a newline, format as in zhfwrite
X        \******************************************************************/
X
X    long zbfread(FILE *f, verylong *a);
X        /******************************************************************\
X        * reads very long int from binary file f into a, returns 1 if success,
X        * 0 if not, file f written using zbfwrite
X        \******************************************************************/
X
X    long zbfwrite(FILE *f, verylong a);
X        /******************************************************************\
X        * writes very long int a to binary file f, returns 1 if success,
X        * 0 if not, file f can be read using zbfread
X        \******************************************************************/
X
X    long zfread_b(FILE *f, verylong *a, verylong in_base, long sym_in);
X        /******************************************************************\
X        * reads base in_base representation of very long int from file f
X        * into a, skips newlines and spaces, but continues on next line only if
X        * line ends with a \, end of input indicated by a newline, accepts
X        * sign on first line, accepts both lower and upper case a, b, c, d, e, f
X        * for digits 10 thru 15, requires decimal representation of digits
X        * for in_base > 16, accepts symmetric digits if sym_in == 1, but
X        * only >=0 digits for sym_in = 0 (with exception of most significant
X        * (is first) digit which might be negative for negative input
X        * if sym_in == 1: -10 -5 (newline ) is interpreted as -10*base -5,
X        * but with sym_in = 0 it is interpreted as -(10*base + 5).
X        * may use _ instead of -, return 1 if success, 0 if not
X        \******************************************************************/
X
X    long zfwrite_b(FILE *f, verylong a, verylong out_base, long sym_out);
X        /******************************************************************\
X        * writes base out_base representation of a to file f, representation
X        * uses digits in [0,...,out_base-1] is sym_out is 0, but uses
X        * digits centered around zero (as far as possible) if sym_out is 1,
X        * only for out_base > 1, for out_base > 16 the digits will be
X        * represented in decimal, for digits 10 thru 15 see zhfwrite
X        * returns the number of digits used for the representation
X        *
X        * possible error message:
X        *   output base < 2 in zfwrite_b        (only for output base > 1)
X        *   allocation failure in zfwrite_b     (a too large to print)
X        *   reallocation failure in zfwrite_b   (a too large to print)
X        *   zfwrite_b...BUG                     (report this)
X        * result undefined if error occurs
X        \******************************************************************/
X
X    long zfwriteln_b(FILE *f, verylong a, verylong out_base, long sym_out);
X        /******************************************************************\
X        * as zfwrite_b, but followed by a newline
X        \******************************************************************/
X
X
X#if 0
X
XExample 1
X=========
XThe following program attempts to find primes p and q with
Xq dividing p-1 and a generator of a subgroup of order q of (Z/pZ)*.
XThe input consists of a seed to initialize the random generator
X(using zrstarts, so seed is an ordinary long), and two integers
Xspecifying the binary lengths of the primes p and q.
X
XNotice the use of Montgomery arithmetic in find_p_q_q: after
Xfinding p, the call zmstart(*p) initializes the Montgomery modulus
Xzn as *p (p is a *verylong in find_p_q_g, so *p is the verylong required
Xfor zmstart), and mont_one contains the Montgomery representation
Xof the constant 1. Also notice the use of the *`s and &`s in the
Xother function calls, to get all arguments at the right pointer-level.
XIf you don`t get all *`s and &`s right, it won`t work. Fortunately,
Xin ansi-C the compiler will complain unless you get it right.
X
X    long 
X    find_p_q_g(
X        long lp,
X        long lq,
X        verylong *p,
X        verylong *q,
X        verylong *g,
X	long (*generator) (long)
X        )
X    {
X        static verylong frac = 0, mont_one = 0;
X        if (!zrandomqprime(lp, lq, 1, p, q, &frac, generator))
X            return (0);
X        zmstart(*p);
X        zintoz((long)1, &mont_one);
X        ztom(mont_one, &mont_one);
X        do
X        {
X            zrandomb(*p, g, generator);
X            zmontexp_m_ary(*g, frac, g, 0);
X        } while (!zcompare(*g, mont_one));
X        zmtoz(*g, g);
X        return (1);
X    }
X
X    main()
X    {
X        verylong p = 0;
X        verylong q = 0;
X        verylong g = 0;
X        long s;
X        long lp;
X        long lq;
X
X        scanf("%ld %ld %ld", &s, &lp, &lq);
X        zrstarts(s);
X        if (find_p_q_g(lp, lq, &p, &q, &g, zrandom))
X        {
X            zwriteln(g);
X            printf("generates a subgroup of order\n");
X            zwriteln(q);
X            printf("in the multiplicative group of integers modulo\n");
X            zwriteln(p);
X        }
X        else
X            printf("couldn`t find primes p and q with q dividing p-1\n");
X    }
X
XSample input:
X
X        12345 128 112
X
Xwith output:
X
X        69380060646427432077308003918712845249
X        generates a subgroup of order
X        2899769708411577578229929781432043
X        in the multiplicative group of integers modulo
X        303797273271447336560836823481509416939
X
X
XExample 2
X=========
XThe following program does the same as the previous one,
Xexcept that it generates two different p`s and g`s (both
Xwith the same q). The second p is generated as above, but
Xthe first p is such that p equals f(m) for a fifth degree
Xpolynomial f with small coefficients, and m close to the
Xfifth root of p. The method below works only for a very
Xlimited range of lq`s (given lp); it works for instance
Xfor lp=512 and lq=160. These p are interesting because the
Xdiscrete logarithm problem modulo such p is much easier (though
Xstill hard...) then for `randomly` chosen p. Generating them,
Xhowever, takes much more time. Notice that such p easily be
Xrecognized using zroot and ztosymbas.
X
X#include "lip.h"
X
X#define BOUND    (2)
X
Xdouble tim;
X
Xfind_x_data(
X    long lc,
X    long lp,
X    verylong *xlow,
X    verylong *xint
X    )
X{
X    static verylong aux=0;
X    zintoz(1,&aux); zlshift(aux,lp-1,&aux);
X    zsdiv(aux,lc,&aux); zroot(aux,5,xlow); zsadd(*xlow,1,xlow);
X    zintoz(1,&aux); zlshift(aux,lp,&aux);
X    zsdiv(aux,lc,&aux); zroot(aux,5,xint);
X    zsub(*xint,*xlow,xint);
X}
X
Xfind_x(
X    long lc,
X    verylong *x,
X    long lp
X    )
X{
X    static verylong xlow[BOUND], xint[BOUND];
X    static long non_init=1, lastlp = 0;
X    register long i;
X    if (non_init) {
X        non_init = 0;
X        for (i=0;i<BOUND;i++) xlow[i]=0;
X        for (i=0;i<BOUND;i++) xint[i]=0;
X    }
X    if (!(xlow[lc-1]) || (lp!=lastlp)) {
X        find_x_data(lc,lp,&(xlow[lc-1]),&(xint[lc-1]));
X        lastlp = lp;
X    }
X    zrandomb(xint[lc-1],x,zrandom);
X    zadd(*x,xlow[lc-1],x);
X}
X
Xlong find_q(
X    verylong x,
X    verylong *q,
X    long lq
X    )
X{
X    static verylong lowq=0, highq=0, nq=0; 
X    static long lastlq=0, p;
X    if (lq != lastlq) {
X        lastlq = lq;
X        zintoz(1,&lowq); zlshift(lowq,lq-1,&lowq);
X        zintoz(1,&highq); zlshift(highq,lq,&highq);
X    }
X    zsq(x,q); zsadd(*q,1,q);
X    zpstart2();
X    /* if lq small compared to 2*lp/5, then increase the 20000 */
X    while ((p=zpnext()) < 20000) {
X        while (!zsdiv(*q,p,&nq)) {
X            if (zcompare(nq,lowq)<0) return 0;
X            zswap(&nq,q);
X        }
X    }
X    if (zcompare(*q,highq) >= 0) return 0;
X    if (zprime(*q,2,2)) return 1;
X    return 0;
X}
X
Xlong find_p(
X    long lp,
X    verylong *p,
X    long a3,
X    verylong x1 
X    )
X{
X    register long a2, a1, a0;
X    static verylong lowp=0, highp=0;
X    static long lastlp=0;
X    static verylong x2=0, x3=0, x4=0, x5=0, aux=0;
X    if (lp != lastlp) {
X        lastlp = lp;
X        zintoz(1,&lowp); zlshift(lowp,lp-1,&lowp);
X        zintoz(1,&highp); zlshift(highp,lp,&highp);
X    }
X    zsq(x1,&x2); zmul(x1,x2,&x3); zsq(x2,&x4); zmul(x1,x4,&x5);
X    zsmul(x5,a3,&x5);
X    for (a2 = -BOUND; a2 <= BOUND; a2 ++)
X    for (a1 = -BOUND; a1 <= BOUND; a1 ++)
X    for (a0 = -BOUND; a0 <= BOUND; a0 ++) {
X        zsmul(x4,a2,p); zadd(x5,*p,p);
X        zsmul(x3,(a1+a3),&aux); zadd(*p,aux,p);
X        zsmul(x2,(a0+a2),&aux); zadd(*p,aux,p);
X        zsmul(x1,a1,&aux); zadd(*p,aux,p);
X        zsadd(*p,(a0+1),p);
X        if ((zcompare(*p,lowp)>=0) && (zcompare(*p,highp)<0) &&
X            (zprobprime(*p,1))) {
X            printf("(%ld,%ld,%ld,%ld,%ld,%ld) in x=",
X                    a3,a2,a1+a3,a2+a0,a1,a0+1);
X            zwriteln(x1);
X            fflush(stdout);
X            return 1;
X        }
X    }
X}
X
Xlong 
Xfind_p_q_g(
X    long lp,
X    long lq,
X    verylong *p,
X    verylong *q,
X    verylong *g,
X    long p_initialized,
X    long q_initialized
X    )
X{
X    static verylong frac = 0, mont_one = 0;
X    if (p_initialized) zdiv(*p,*q,&frac,&mont_one);
X    else if (q_initialized) {
X        if (!zrandomqprime(lp,-1,1,p,q,&frac,zrandom))
X            return 0;
X    } else if (!zrandomqprime(lp, lq, 1, p, q, &frac,zrandom))
X        return (0);
X    zmstart(*p);
X    zintoz((long)1, &mont_one);
X    ztom(mont_one, &mont_one);
X    do
X    {
X        zrandomb(*p, g,zrandom);
X        zmontexp_m_ary(*g, frac, g, 0);
X    } while (!zcompare(*g, mont_one));
X    zmtoz(*g, g);
X    return (1);
X}
X
Xlong search(
X    long lp, 
X    long lq,
X    verylong *p,
X    verylong *q,
X    verylong *g
X    )
X{
X    register long a3,cnt=100,cnt2=0;
X    verylong x1=0;
X    tim = gettime();
X    for (;;) {
X        for (a3=BOUND;a3 > 0; a3 --) {
X            find_x(a3,&x1,lp);
X            if (find_q(x1,q,lq)) {
X                if (find_p(lp,p,a3,x1)) {
X                    if (find_p_q_g(lp,lq,p,q,g,1,0)) {
X                        return 1;
X                    } else {
X                        printf("failure, bug\n");
X                        return 0;
X                    }
X                }
X            }
X            cnt --; cnt2 ++;
X            if (!cnt) {
X                cnt = 100;
X                printf("%12.8lf\n",gettime()-tim);
X            }
X        }
X    }
X}
X
Xmain () {
X    long seed, lp, lq;
X    verylong p=0, q=0, g=0;
X    scanf("%ld %ld %ld",&seed,&lp, &lq);
X    zrstarts(seed);
X    if ((5*lq < lp) || (5*lq >= 2*lp)) {
X        printf("wrong choice of lq, given lp\n");
X    } else {
X        search(lp,lq,&p,&q,&g);
X        zwriteln(g);
X        printf("generates a subgroup of order\n");
X        zwriteln(q);
X        printf("in the multiplicative group of integers modulo\n");
X        zwriteln(p);
X        printf("\n"); fflush(stdout);
X        find_p_q_g(lp,lq,&p,&q,&g,0,1);
X        zwriteln(g);
X        printf("generates a subgroup of order\n");
X        zwriteln(q);
X        printf("in the multiplicative group of integers modulo\n");
X        zwriteln(p);
X    }
X}
X
XSample input:
X
X        91827 512 160
X
Xwith output (ran on a Dec5000):
X
X  8.06589000
X 16.05366000
X 24.06877200
X 32.06826000
X 40.07946600
X 48.03598800
X 55.96907400
X 63.97246800
X 71.94070800
X 79.95972600
X(2,-1,4,1,2,3) in x=5732728338564277933401923623292
X9591799259966573164342540675955801429916823022178896361655948850792930\
X515587637996156997151205096920718969500071125549295057930871953036227670\
X445621739151
Xgenerates a subgroup of order
X1230839171037341070074005775035308892107198955613
Xin the multiplicative group of integers modulo
X12383311727928453371624147227434742196274290935625312561242436860629120\
X363552724053425620545011527277462501019737050954450372742327329524674903\
X594316872971
X
X4365299391537094934964660353154494247817813010409537807179247202857826\
X545061157151311977258039110389051584394918213988061761768130524172068355\
X498288215627
Xgenerates a subgroup of order
X1230839171037341070074005775035308892107198955613
Xin the multiplicative group of integers modulo
X13143708246123080779962762988615698543794631834573732384461020379244956\
X286733233180322530379058590495369810743153060672783621613129719414041546\
X267255683951
X
X
XIf we compile and run the same program with all occurrences of
Xzrandom replaced by myrandom, where myrandom is defined as
X
Xlong
Xmyrandom(
X        long b
X        )
X{
X        return(rand()%b); /* standard C random generator */
X}
X
X(notice that the call to zrstart does not make much sense now,
Xit should be replaced by a call to srand), the same input produces
X(on a Dec5000)
X
X...
X609.20710200
X617.12065800
X624.98734200
X(2,2,1,2,-1,1) in x=5802771722845025357104197852426
X6250662616862772671869524680619116457926002829463242950803998171443689\
X384478553026585601121767500760031377571255180203793949756177020821340300\
X648560042459
Xgenerates a subgroup of order
X823975903443431258501153365712982941850723214729
Xin the multiplicative group of integers modulo
X13158531543572653995139067835434751017649945012023172051033952721717908\
X339351769129537785960252159399099325489058027027491927948773975574456412\
X952258963207
X
X8129927393902447229596445362002583103438217104111265989840242958213577\
X880751776075448409586706127209647185741406377036301444358487212051349365\
X958616089131
Xgenerates a subgroup of order
X823975903443431258501153365712982941850723214729
Xin the multiplicative group of integers modulo
X10625180640031129836760363301328144899231041896781644627199069577686628\
X184985638203602429686525241755504389012712726828022450736516656003671860\
X215311465577
X
X
X============================================================================
X
XThe package was tested on  ULTRIX V4.2,  HP-UX 8.05,  SunOS 4.1.1&2,
X                           AIX V3.1, IRIX 4.0.5
X
XBugs, questions, suggestions, additions, whatever, to
X
X                Arjen K. Lenstra
X                Room 2Q334
X                Bellcore
X                445 South Street
X                Morristown, NJ 07960
X
X                email: lenstra@flash.bellcore.com
X                tel: 201 829 4878
X                fax: 201 829 2645
X
X                                            1993 08 09
X}
X#endif
END_OF_FILE
if test 111545 -ne `wc -c <'src/lip.h'`; then
    echo shar: \"'src/lip.h'\" unpacked with wrong size!
fi
# end of 'src/lip.h'
fi
if test -f 'src/mpqs.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'src/mpqs.c'\"
else
echo shar: Extracting \"'src/mpqs.c'\" \(58060 characters\)
sed "s/^X//" >'src/mpqs.c' <<'END_OF_FILE'
X/* ppmpqs without maxbig, based on lip.c */ 
X/* mpqs restartfile [infile logfile [outputdirectory/ [mail-cmd]]] */
X#include <math.h>
X#include <stdio.h>
X#include <signal.h>
X#include <sys/time.h>
X#include <sys/resource.h>
X#include "lip.h"
X
X#if defined(sparc) && defined(__svr4__)
X#include <sys/rusage.h>
X#endif /* SOLARIS */
X
X#ifdef NO_SQRTKN
X#include <unistd.h>		/* need SEEK_SET */
X#endif
X
X#define NBITS (30)
X#define RADIX (1<<NBITS)
X
X#ifndef MAILBATCH
X#define MAILBATCH 25
X#endif
X#define LINELENGTH 50
X#define STARTER 1
X#define SLAVE 2
X#define FIREFLY 3
X#ifndef CHECK 
X#define CHECK 1000        /* check every CHECK polynomials */
X#endif
X#ifndef REPORT 
X#define REPORT 25         /* report every REPORT polynomials */
X#endif
X#ifndef MAXPOL
X#define MAXPOL 100000     /* who will ever reach that in one run */
X#endif
X#define MAXSMALLPRIME 97
X#define MAXSMALLPRIMEP 98
X#ifndef MAXSIEVE
X#define MAXSIEVE 3000000
X#endif
X#define MINSIEVE 100000
X#define FIRST_GE_SENTINEL 4
X#define SMALLCORRECT 2
X#ifdef RISC
X#define BYTSOF1 1
X#else
X#if __alpha
X#define BYTSOF1 0x0101010101010101
X#define LOGLONGSIZE 3
X#else
X#define BYTSOF1 0x01010101
X#define LOGLONGSIZE 2
X#endif
X#endif
X#define MAXFACNB 200
X
X#ifndef BUILD_RESTART
X#define BUILD_RESTART 1 /* 1 to write restart file, 0 to omit */
X	/* When creating RESTART, USEHEX reduces file size  */
X	/* by 40% but the resultant file is harder to read. */
X#endif
X#ifdef USEHEX
X#define SPNUM " %lx"
X#define NOSPNUM "%lx"
X#else
X#define SPNUM " %ld"
X#define NOSPNUM "%ld"
X#endif
X
X#if CONTRIBUTION_3
X/*  
X   Contribution 3 has assembly language versions of selected
X   mpqs.c and basic.c routines for 68020-based machines.
X*/ 
X#define ASM_bigp_siever 1
X#define ASM_lowp_siever 1
X#define ASM_medp_siever 1
X#define ASM_sieveinit   1
X#endif
X#if CONTRIBUTION_8
X/*
X   Contribution 8 has assembly language versions of selected
X   mpqs.c and basic.c routines for SPARC (i.e., SUN 4) systems.
X*/
X#define ASM_bigp_siever 1
X#define ASM_first_ge    1
X#define ASM_lowp_siever 1
X#define ASM_medp_siever 1
X#define ASM_sieveinit   1
X#endif
X
X
X/* Globals */
X
X#ifdef __alpha
X#define uchar u__char
X#endif
X
X#ifndef _IBMR2
X#ifdef RISC
Xtypedef long uchar;
X#else
Xtypedef unsigned char uchar;
X#endif
X#endif /* RS/6000 */
X
Xtypedef long *row;
Xtypedef uchar *urow;
X
XFILE *sendit;
XFILE *mailit;
XFILE *restart;
X
Xverylong n=0, kn=0, sqkn=0, startd=0, altstartd=0, dum=0;
X
Xlong tobemailed,
X        multiplier, sizefacbase, lastprime, sievelength, sievesize, maxbig,
X        unique, how, outputcounter = 0, notallocated = 1, identification,
X	nbsmallps, nbsmallpsp, logcnt, closeit,
X	ful = 0, maxful = 0, minful = 100000, sumful = 0,
X        par = 0, maxpar = 0, minpar = 100000, sumpar = 0,
X        ppr = 0, maxppr = 0, minppr = 100000, sumppr = 0,
X        bad = 0, maxbad = 0, minbad = 100000, sumbad = 0,
X        pol = 0, numfac = 0, interrupted = 0, started = 0,
X	ecc = 0, ecs = 0, prc = 0, woc = 0, lac = 0, mic = 0,
X	signalinterrupt = 0;
X
X#ifndef NO_TIMING
Xstruct rusage used;
X#endif
X
Xdouble timestart, timenow;
X
Xchar callsendit[400], nameoutput[300], hostname[100], parid[20], fulid[20],
X	pprid[20], ppridc[20],
X        paridc[20], fulidc[20],
X        *restartfn;
Xchar default_restart[] = "RESTART";
Xchar *file_prefix = "";
X#ifndef MAILCMD
Xchar *mail_cmd="mail factor@src.dec.com < %s";
X#else
Xchar *mail_cmd=MAILCMD;
X#endif
X
Xlong luchar = sizeof(uchar);
X 
Xlong logpstart[30], nextlog[30];
Xuchar smallsievebnd, sievebound, firstlog, lastlog;
Xdouble smlogp[MAXSMALLPRIMEP];
X 
Xlong smallprimes[] = {0,0,128,243,0,125,0,343,0,0,0,121,0,169,
X                        0,0,0,289,0,361,0,0,0,529,0,0,0,0,0,841,0,961,
X0,0,0,0,0,1369,0,0,0,1681,0,1849,0,0,0,2209,0,0,0,0,0,2809,0,
X0,0,0,0,3481,0,3721,0,0,0,0,0,4489,0,0,0,5041,0,5329,0,0,0,0,0,6241,
X0,0,0,6889,0,0,0,0,0,7921,0,0,0,0,0,0,0,9409 };
X#ifdef __alpha
Xtypedef struct {int r1; int r2;} roots_t;
X#else
Xtypedef struct {long r1; long r2;} roots_t;
X#endif
Xroots_t *roots;
X#ifdef NO_SQRTKN
Xlong sqrtkni, sqrtknbase;
X#endif
Xrow primbase, sqrtkn;
Xurow sieve;
X 
X/* End Globals */
X 
Xlong smalldiv()
X{ long p;
Xzpstart();
Xwhile ((p=zpnext()) <= lastprime) {
X        if  (!zsmod(n,p)) return(p);
X        }
Xreturn(0);
X}
X 
Xlong findmultiplier(t)        /* returns selected multiplier for n, where   */
X                        /* t primes will be considered per candidate        */
Xlong t;
X{ long p, try, besttry = 1, nmod4, i, j, nbcand = 42;
X  static verylong longp = 0;
X  double dp, tryval, besttryval = 1.0;
X  static long cand[] = { 1,3,5,7,11,13,15,17,19,21,23,29,31,33,35,37,
X                        39,41,43,47,51,53,55,57,59,61,65,67,69,71,73,79,
X                        83,85,89,91,93,95,97,101,103,105 };
X/* that is probably enough! */
Xnmod4 = n[1] % 4;
Xfor (j=0;j<nbcand;j++) {
X        if (((try = cand[j])*nmod4 % 4) != 1) continue;
X        zpstart();                        /* so that next prime will be 3 */
X        i = 0;
X        tryval = -0.5*log((double)try);
X        zsmul(n,try,&kn);
X        if ((kn[1]%8) == 1) { i++; tryval += 1.38629; } /* log(4) */
X        p = zpnext();
X        while (i < t) {
X		zintoz(p,&longp);
X		zintoz(zsmod(kn,p),&dum);
X		zsexpmod(dum,p/2,longp,&dum);
X                if (dum[1] == 1) {
X                        i++; dp = (double)p; dp = (log(dp))/dp;
X                        if (try%p == 0) tryval += dp;
X                        else tryval += 2.0*dp;
X                        }
X                p = zpnext();
X                }
X        if (tryval > besttryval) { besttry = try; besttryval = tryval; }
X        }
Xreturn(besttry);
X}
X 
Xlong root(u,p,lit)        /* returns square root of u modulo prime p */
X/* dirty, could make this more efficient, needed only in initialization */
Xlong u,p,lit;
X{ long e, q, n, v, w;
X  if (u <= 1) return(u);
X  if (lit) {  /* separate code for prime powers (smallprimes) */
X          for (n=0; n<p; n++) if ((((n*n)-u) % p) ==0 ) return(n) ;
X        return(0);
X        }
X  e = 0; q = (p-1)/2;
X  while ((q&1) == 0) { e++; q >>= 1; }  /* p = 1 + q*(2^(e+1)), q odd */
X  w = zexpmods(u, (q-1)/2, p);
X  v = zmulmods(u, w, p);  /* u^((q+1)/2) */
X  if (e != 0) {
X     long r, yroots[NBITS];	/* yroots[k] = (2^k) root of -1 */
X     w = zmulmods(v, w, p);  /* u^q */
X     for (n=5; ; n+=6) {
X	long k;
X  	if (n >= 1000) {
X	    printf("root - can't find non-residue for %ld \n", p);
X	    exit(0);
X        }
X        if (zjacobis(n, p) != -1) continue;
X	yroots[e] = zexpmods(n, q, p);
X        for (k=e; k>0; k--) {
X	    yroots[k-1] = zmulmods(yroots[k], yroots[k], p);
X	}
X	if (yroots[0] == p-1) break;
X     }
X     r = e+1;
X     while (w != 1) {	/* v^2 == u*w, w^(2^(r-1)) == 1 */
X          long k = 1, z = w;
X	  while (z != p-1) {	
X	       z = zmulmods(z, z, p);
X               if (k++ >= r) {
X		  printf("Error in root, perhaps a non-residue:\n");
X		  printf("p=%ld, u=%ld, v=%ld, w=%ld, r=%ld, z=%ld, n=%ld\n",
X		 	p, u, v, w, r, z, n);
X	 	  exit(0);
X	       }
X	  }
X	  v = zmulmods(v, yroots[k], p);
X          w = zmulmods(w, yroots[k-1], p);
X          r=k;
X/*
X	  printf("root - u = %ld, p=%ld, v=%ld, w=%ld, r=%ld\n",
X		u, p, v, w, r);
X*/
X     } /* while w */
X  } /* if e */
X  if (v > p/2) v = p-v;
X  if (zmulmods(v,v,p) != u) {
X	printf("Error in root: %ld %ld %ld \n", u, p, v);
X	exit(0);
X  }
X  return(v);
X}
X 
Xcreatefactorbase()
X{ long lit, p, knmodp, i = 1;
Xuchar addlog;
Xlong exp_addlog;
Xzpstart();        /* so that next prime will be 3 */
Xif ((kn[1]%8) == 1) {
X        primbase[1] = 2;
X        sqrtkn[1] = root(kn[1],smallprimes[2],(long)1);
X        i = 2; nbsmallps = 1;
X	}
Xelse nbsmallps = 0;
Xwhile (i <= sizefacbase) {
X	lit=0;
X	p = zpnext();
X        knmodp = zsmod(kn, p);
X        if (zjacobis(knmodp, p) != -1 || p == multiplier) {
X                primbase[i] = p;
X                if (p <= MAXSMALLPRIME) {
X			lit =1;
X			nbsmallps ++;
X                        p = smallprimes[p];
X                        knmodp = zsmod(kn, p);
X		}	
X                sqrtkn[i] = root(knmodp,p,lit);
X                i++;
X                }
X        }
Xnbsmallpsp = nbsmallps + 1;
Xlastprime = primbase[sizefacbase];
Xfor (i=1; i<=nbsmallps; i++)
X	smlogp[i]=(log((double)primbase[i])/1.0);
Xlogcnt = 0;
Xif (i<=sizefacbase) {
X	firstlog = (uchar)(log((double)primbase[i])/1.0);
X	addlog = firstlog;
X	exp_addlog = (long)(exp((double)(addlog+1))/1.0);
X}
Xi++;
Xfor (; i<=sizefacbase; i++) {
X	if (primbase[i] > exp_addlog ) {
X		nextlog[logcnt++] = primbase[i];
X		addlog ++; /* step > 1 possible error, but unlikely */
X				/* to affect many logs, at most a few */
X		exp_addlog = (long)(exp((double)(addlog+1))/1.0);
X	}
X}
Xnextlog[logcnt] = lastprime+1;
X}
X 
Xvoid findsievebound()
X/* better to determine experimentally */
X/* this one gives a rather low result (which is better, */
X/* because it gives more information. In the course of the */
X/* computation the bound should be adapted.        */
X{ double lkn, loglast;
Xlkn = log((double)kn[kn[0]]) + (double)(kn[0]-1)*log((double)RADIX);
Xloglast = 2 * log((double)maxbig);
Xsievebound=(uchar)(((lkn+log((double)sievelength))/2.0-loglast)/1.0-4.0);
Xsmallsievebnd= sievebound - (uchar)SMALLCORRECT;
X}
X 
Xlong dumpdata() {
X/* dump in decimal notation, and not using fwrite, so */
X/* that different machines can read each others restart file */
X/* slow, but saves more time that it wastes */
X/* put on separate lines, to make it easier to change RESTART */
X/* using some editor (long line can cause problems) */
Xregister long i;
Xif (fprintf(restart,"%ld",sizefacbase) < 0) return(1);
Xif (fprintf(restart," %ld\n",identification) < 0) return(1);
Xzfwriteln(restart,n);
Xif (fprintf(restart,"%ld\n",multiplier) < 0) return(1);
Xzfwriteln(restart,sqkn);
Xif (fprintf(restart,"%ld",sievelength) < 0) return(1);
Xif (fprintf(restart," %ld",(long)sievebound) < 0) return(1);
Xif (fprintf(restart," %ld\n",maxbig) < 0) return(1);
Xif (fprintf(restart," %ld\n",nbsmallps) < 0) return(1);
Xfor (i=1; i<=nbsmallps; i++) {
X	if (fprintf(restart," %ld",(long)smlogp[i]) < 0) return(1);
X        if (i%5 == 0) fprintf(restart,"\n");
X        }
Xif (fprintf(restart," %ld\n",(long)firstlog) < 0) return(1);
Xif (fprintf(restart," %ld\n",logcnt) < 0) return(1);
Xfor (i=0; i<=logcnt; i++) {
X	if (fprintf(restart," %ld",nextlog[i]) < 0) return(1);
X        if (i%5 == 0) fprintf(restart,"\n");
X        }
Xif (i%5 != 1) fprintf(restart,"\n");
Xzfwriteln(restart,startd);
Xfor (i=1; i<=sizefacbase; i++) {
X#ifdef USEHEX
X        long gap = (i <= 2) ? primbase[i]
X                            : ((primbase[i]-primbase[i-1]) >> 1);
X#else
X        long gap = primbase[i];
X#endif
X        if (fprintf(restart," %ld",gap) < 0) return(1);
X        if (i%5 == 0) fprintf(restart,"\n");
X        }
Xfor (i=1; i<=sizefacbase; i++) {
X        if (fprintf(restart,SPNUM,sqrtkn[i]) < 0) return(1);
X        if (i%5 == 0) fprintf(restart,"\n");
X        }
Xfflush(restart);
X#ifdef NO_SQRTKN
Xfree (sqrtkn);
X#else
Xfclose(restart);
X#endif
Xreturn(0);
X}
X 
Xmakestartd() {
X	long zcompare();
X        if (unique < 0) {
X		zintoz(-unique,&altstartd); zlshift(altstartd,NBITS,&altstartd);
X		if (zcompare(altstartd,startd) >= 0) {
X                    printf("negative unique process ID not allowed, exit\n");
X               		exit(0);
X		}
X		zsub(startd,altstartd,&startd);
X		startd[1] |= 3;
X        }
X	else {
X		zintoz(unique,&altstartd); zlshift(altstartd,NBITS,&altstartd);
X		zadd(altstartd,startd,&startd);
X        	startd[1] |= 3;
X	}
X/* no overlap is almost guaranteed in this way, unless machines are */
X/* VERY fast, and run for a LONG time. resulting values are close */
X/* enough to optimal for our range of interest (10^90 - 10^110) */
X}
X 
Xgetmemory() {
Xlong bytefacbase = (sizefacbase+1) * sizeof(long);
Xif (((primbase = (long*)malloc(bytefacbase))==NULL)||
X        ((sqrtkn=(long*)malloc(bytefacbase))==NULL) ||
X        ((roots=(roots_t*)malloc((sizefacbase+1)*sizeof(roots_t)))==NULL)) {
X                printf("unable to get memory, exit\n");
X                exit(0);
X        }
X        notallocated = 0;
X#if 0
X	printf("primbase = %lx, sqrtkn = %lx, roots = %lx\n",
X		    (long)primbase, (long)sqrtkn, (long)roots);
X#endif
X}
X
Xtimestamp () {
X        long tp = time(NULL);
X#ifdef NO_TIMING
X	printf (" at %s", ctime (&tp));
X#else
X        getrusage (RUSAGE_SELF, &used);
X#if defined(sparc) && defined(__svr4__)
X        timenow = used.ru_utime.tv_sec + used.ru_utime.tv_nsec / 1e9;
X        timenow += used.ru_stime.tv_sec + used.ru_stime.tv_nsec / 1e9;
X#else
X        timenow = used.ru_utime.tv_sec + used.ru_utime.tv_usec / 1e6;
X        timenow += used.ru_stime.tv_sec + used.ru_stime.tv_usec / 1e6;
X#endif /* SOLARIS */
X        printf(" after %10.2lf seconds at %s",timenow-timestart,ctime(&tp));
X#endif /* NO_TIMING */
X        fflush(stdout);
X}
X 
Xlong getandalloc() {
Xregister long i;
Xlong dummy; 
Xif (how == SLAVE) {
X        printf("Attempt to read restart file %s", restartfn); timestamp();
X        if ((restart=fopen(restartfn,"r"))==NULL) return(1);
X        if (fscanf(restart,"%ld",&sizefacbase) == EOF) goto wrong;
X        if (fscanf(restart,"%ld",&dummy) == EOF) goto wrong;
X        if (dummy != identification) goto wrong;
X        zfread(restart,&dum);
X        if (zcompare(n,dum) != 0) goto wrong;
X}
Xelse {
X        printf("impossible call to getandalloc, exit"); timestamp();
X        exit(0);
X}
X 
X/*successfully opened file, and contains the right n */
X 
Xgetmemory();
Xif (fscanf(restart,"%ld",&multiplier)==EOF) goto wrong;
Xzfread(restart,&sqkn);
Xif (fscanf(restart,"%ld",&sievelength)==EOF) goto wrong;
Xif (fscanf(restart,"%ld",&dummy)==EOF) goto wrong;
Xsievebound = (uchar)dummy;
Xsmallsievebnd= sievebound - (uchar)SMALLCORRECT;
Xif (fscanf(restart,"%ld",&maxbig)==EOF) goto wrong;
Xif (fscanf(restart,"%ld\n",&nbsmallps)==EOF) goto wrong;
Xnbsmallpsp= nbsmallps+1;
Xfor (i=1; i<=nbsmallps; i++) {
X	if (fscanf(restart,"%ld",&dummy)==EOF) goto wrong;
X        }
Xif (fscanf(restart,"%ld\n",&dummy)==EOF) goto wrong;
Xfirstlog = (uchar)dummy;
Xif (fscanf(restart,"%ld\n",&logcnt)==EOF) goto wrong;
Xfor (i=0; i<=logcnt; i++) {
X	if (fscanf(restart,"%ld",&nextlog[i])==EOF) goto wrong;
X        }
Xzfread(restart,&startd);
Xfor (i=1;i<=sizefacbase;i++) {
X        if (fscanf(restart,"%ld",&primbase[i]) == EOF) goto wrong;
X#ifdef USEHEX
X 	if (i > 2) primbase[i] = primbase[i-1] + 2*primbase[i];
X#endif
X 	}
X
X#ifdef NO_SQRTKN
Xsqrtknbase = ftell (restart);
X#else
X
Xfor (i=1;i<=sizefacbase;i++)
X        if (fscanf(restart,NOSPNUM,&sqrtkn[i]) == EOF) goto wrong;
X 
Xfclose(restart);
X#endif
X 
Xfor (i=1; i<=nbsmallps; i++)
X	smlogp[i]=(log((double)primbase[i])/1.0);
X 
Xlastprime = primbase[sizefacbase];
Xzsmul(n,multiplier,&kn);
Xif ((multiplier>1) && (multiplier <= MAXSMALLPRIME))
X        smallprimes[multiplier] = multiplier;
Xmakestartd();
Xreturn(0);
X 
Xwrong:
Xfclose(restart);
Xif (how == SLAVE) {
X        unlink(restartfn);
X        printf("Attempt failed, restart file removed, creating %s",
X            restartfn); timestamp();
X}
Xelse printf("Exit: unsuccessful restart"); timestamp();
Xreturn(1);
X}
X 
X
Xsetupmailer() {
X        scanf("%ld",&tobemailed);
X        printf("the results will be written to the file %s\n",nameoutput);
X        if (tobemailed) {
X                sprintf(callsendit,mail_cmd, nameoutput);
X                printf("As soon as it contains %ld relations,\n",MAILBATCH);
X                printf("this file will be mailed using the command:\n");
X                printf("    %s\n",callsendit);
X        } else {
X                printf("Please process %s every now and then:\n",nameoutput);
X#ifdef VMS
X		printf("   $ rename %s MAILOUT\n", nameoutput);
X		printf(" (wait a moment, maybe process is writing to MAILOUT)\n    $ ");
X		printf(mail_cmd, "MAILOUT"); printf ("\n");
X#else
X                printf("     mv %s MAILOUT\n",nameoutput);
X		printf(" (wait a moment, maybe process is writing to MAILOUT)\n     ");
X                printf(mail_cmd, "MAILOUT\n");
X#endif
X                }
X        fflush(stdout);
X}
X 
Xsetup () {
Xlong bytefacbase, dummy;
X#if BUILD_RESTART
Xchar restartname[150];
X#endif
X 
Xzstart(); /* set up long integer arithmetic */
X 
Xif (how != STARTER) {
X        scanf("%ld %ld",&identification,&unique);
X        sprintf(parid,"par%ld#",identification);
X        sprintf(pprid,"ppr%ld#",identification);
X        sprintf(fulid,"ful%ld#",identification);
X        sprintf(paridc,"par%ldc#",identification);
X        sprintf(ppridc,"ppr%ldc#",identification);
X        sprintf(fulidc,"ful%ldc#",identification);
X        sprintf(nameoutput,"%sOUT%07ld",file_prefix,unique);
X        zrstarts(abs(unique)+1);
X}
X 
Xif (how == SLAVE) {
X        zread(&n);
X        if (getandalloc() == 0) {
X                printf("successful restart from file %s", restartfn);
X		timestamp();
X                scanf("%ld",&dummy); /* multiplier does not change */
X                scanf("%ld",&dummy); /* sizefacbase does not change */
X                scanf("%ld",&sievelength); /* sievelength may be changed */
X                scanf("%ld",&dummy);
X                sievebound = (uchar)dummy; /* sievebound may be changed */
X                scanf("%ld",&maxbig); /* maxbig may be changed */
X                zread(&startd);
X                makestartd();
X        }
X        else {
X                scanf("%ld %ld",&multiplier,&sizefacbase);
X                zsmul(n,multiplier,&kn); zsqrt(kn,&sqkn,&dum);
X                if ((multiplier>1) && (multiplier <= MAXSMALLPRIME))
X                        smallprimes[multiplier] = multiplier;
X                if (notallocated) getmemory();
X                scanf("%ld %ld %ld",&sievelength,&dummy,&maxbig);
X                sievebound = (uchar)dummy;
X 
X                printf("start creation new restart data"); timestamp();
X                createfactorbase();
X                zread(&startd);
X#if BUILD_RESTART
X#ifdef VMS
X		/* VMS has versioning, don't need to make unique */
X                strcpy(restartname, restartfn);
X#else
X                sprintf(restartname,"%s%07ld",restartfn, unique);
X#endif /*VMS*/
X                if ((restart = fopen(restartname,"w")) == NULL) {
X                        printf("Cannot create restart file %s, non fatal\n",
X			       restartname);
X                }
X                else {
X                        if (dumpdata()) {
X                                printf(
X				  "Cannot dump restart data, non fatal\n");
X                                unlink(restartname);
X                        }
X                        else {
X#ifndef VMS
X                                link(restartname, restartfn);
X                                unlink(restartname);
X#endif /*VMS */
X                                printf(
X				  "Created restart file %s", restartfn);
X				timestamp();
X                        }
X                }
X                fflush(stdout);
X#endif /* BUILD_RESTART */
X                makestartd();
X        }
X        smallsievebnd= sievebound - (uchar)SMALLCORRECT;
X        printf("multiplier: %ld\n",multiplier);
X        printf("sizefacbase: %ld\n",sizefacbase);
X        printf("sievelength: %ld\n",sievelength);
X        printf("sievebound: %ld\n",(long)sievebound);
X        printf("maxbig: %ld\n",maxbig);
X        printf("startd:"); zwrite(startd);
X        printf("\n"); fflush(stdout);
X        setupmailer();
X        started = 1;
X        return;
X}
X 
Xif (how == STARTER) { /*includes FIREFLYSTART */
X        /* reads n, n's ID, sizefacbase, and maxbig */
X        /* builds RESTART, prints restartvalues, and stops */
X 
X        printf("start up, create restart file in this directory\n");
X        printf("give following data:\n");
X        printf("        number to be factored,\n");
X        printf("        its unique identification,\n");
X        printf("        size of factor base,\n");
X        printf("        and bound for largest prime in partials.\n");
X        fflush(stdout);
X 
X        zread(&n);
X        scanf("%ld",&identification);
X        if ((n[1] & 1) == 0) {
X                printf("input is even, exit\n"); exit(0);
X        }
X 
X        scanf("%ld %ld",&sizefacbase,&maxbig);
X        printf("begin computing restart data for factorization of\n");
X        zwrite(n); printf("\n");
X        printf("identification: %ld\n",identification);
X        printf("size factor base: %ld\n",sizefacbase);
X        printf("primes in partial factorizations at most: %ld\n",maxbig);
X        fflush(stdout);
X 
X        multiplier = findmultiplier((long)100);
X        printf("multiplier: %ld\n",multiplier); fflush(stdout);
X        zsmul(n,multiplier,&kn); zsqrt(kn,&sqkn,&dum);
X        if ((kn[1] % 4) != 1) {
X                printf("wrong multiplier selected, exit\n");
X                exit(0);
X        }
X        if ((multiplier>1) && (multiplier <= MAXSMALLPRIME))
X                smallprimes[multiplier] = multiplier;
X        bytefacbase = (sizefacbase+1) * sizeof(long);
X        if (((primbase = (long*)malloc(bytefacbase)) == NULL) ||
X                ((sqrtkn = (long*)malloc(bytefacbase)) == NULL)) {
X                printf("unable to get memory, exit\n");
X                exit(0);
X        }
X 
X        createfactorbase(); /* puts data in primbase, r1, and log info */
X                        /* also sets lastprime */
X        printf("factor base created\n"); fflush(stdout);
X        if ((dummy = smalldiv()) > 0 ) {
X                printf("small factor: %ld, exit\n",dummy);
X                exit(0);
X        }
X        printf("largest prime in factor base: %ld\n",lastprime);
X#ifdef SIEVEL
X        if ((sievelength = SIEVEL*lastprime) > 400)
X#else
X        if ((sievelength = 2*lastprime) > 400) /* results in 4*lastprime */
X#endif
X                sievelength = 400*((sievelength+200)/400);
X        printf("sieve length: %ld\n",sievelength);
X 
X        findsievebound();
X        printf("sievebound: %ld\n",(long)sievebound);
X	fflush(stdout);
X 
X        z2div(kn,&dum);                zsqrt(dum,&startd,&dum);
X        zintoz(sievelength,&dum);        zdiv(startd,dum,&dum,&startd);
X        zsqrt(dum,&startd,&dum);                startd[1] |= 3;
X        if ((startd[0] > 1 ) || (startd[1] > 4))
X		zsadd(startd,(long)-4,&startd);
X        printf("polynomial generator starts at: ");
X        zwriteln(startd);
X	fflush(stdout);
X 
X        if ((restart = fopen(restartfn,"w")) == NULL) {
X                printf("Could not open restart file, exit\n");
X                exit(0);
X        }
X        if (dumpdata()) {
X                printf("Could not write restart file, exit\n");
X                unlink(restartfn);
X                exit(0);
X        }
X        printf("restart file created, done\n");
X        printf("\n");
X        printf("Give each machine the following input:\n");
X        printf("--------- ><8 --------- \n");
X        printf("%ld %ld i\n",SLAVE,identification);
X        zwriteln(n);
X        printf("%ld %ld %ld %ld %ld\n",multiplier,sizefacbase,
X                        sievelength,(long)sievebound,maxbig);
X        zwriteln(startd);
X        printf("0/1\n");
X        printf("address\n");
X        printf("\n");
X        printf("--------- ><8 --------- \n");
X        printf(
X	  "The second to last line contains a zero or a one; a one if\n");
X        printf("the results should be mailed to address (last line), a\n");
X        printf("zero if the owner of that machine will mail the\n");
X        printf(
X	  "results. The mpqs-process will create a file RESTART which\n");
X        printf("can be used by other processes running in the same\n");
X        printf("directory; this file will not be created if it already\n");
X        printf("exists for this n (with the same identification).\n");
X        printf(" The i on the first line should be an integer and at\n");
X        printf(
X	  "least zero. It should be different from any i given to other\n");
X        printf("processes. Never use any i more than once, even on the\n");
X        printf("same machine, to avoid duplicating curves/relations.\n");
X        exit(0);
X        }
X
X/* how is not STARTER, SLAVE or FIREFLY: */
X        printf("wrong restart value, exit\n");
X        exit(0);
X}
X 
Xfindnextpolynomial(a,b,d2inv)
Xverylong *a, *b, *d2inv;
X{
Xstatic verylong t1=0, t2=0, t3=0, t2kn=0, t4=0, ro1=0, ro2=0, pp=0;
Xregister long i, p, ap, bp, bpc;
Xlong rem1, mod1 = 1033715657;		/* 13*23*37*41*43*53 */
Xlong rem2, mod2 = 1035563755;		/*  5*17*29*61*67*97 */
Xlong rem3, mod3 = 1036405977;		/*  3*19*47*59*79*83 */
Xlong rem4, mod4 = 1039058713;		/*  7*11*31*67*73*89 */
X 
Xi = 1;
Xzcopy(startd,&altstartd);
Xinterrupted = 1;
Xstartd[1] |= 3; /* to be sure */
Xrem1 = zsmod(startd, mod1); rem2 = zsmod(startd, mod2);
Xrem3 = zsmod(startd, mod3); rem4 = zsmod(startd, mod4);
Xwhile (i > 0) {
X        zsadd(startd,(long)4,&startd);
X	rem1 += 4; rem2 += 4; rem3 += 4; rem4 += 4;
X        if (    zjacobis(rem1,mod1) == 0 || zjacobis(rem2,mod2) == 0
X             || zjacobis(rem3,mod3) == 0 || zjacobis(rem4,mod4) == 0) continue;
X			/* Reject d if divisible by odd prime < 100 */
X	zrshift(startd,(long)2,&t1);	/* t1 = (d-3)/4 */
X	zexpmod(kn,t1,startd,&t2); 		/* t2 = 1/sqrt(kn) mod d if d good */
X	zmul(t2,kn,&t2kn); 		/* t2kn = t2*kn = kn^((d+1)/4) mod d */
X	zmul(t2,t2kn,&t3); zdiv(t3,startd,&t4,&t1); /* kn^((d-1)/2) mod d */
X        if ((t1[0] != 1) || (t1[1] != 1)) continue; /* nonresidue or nonprime*/
X        if (zprime(startd, (long)1, 2) > 0) i = 0;	 /* insurance */
X        }
Xinterrupted = 0;
Xzmod(t4,kn,d2inv); if ((*d2inv)[1]&1) zadd(*d2inv, kn, d2inv);
Xz2div(*d2inv,d2inv); zsub(kn,*d2inv,d2inv); /* d2inv = 1/2d mod kn */
X
Xzsq(startd,a); zmod(t2kn,*a,&t2kn); zmod(t3,*a,&t3);
X/* Compute b = t2*kn*(t2^2*kn - 3)/2 = sqrt(kn) mod a */
Xzsadd(t3,(long)-3,&t3);        zmulmod(t2kn,t3,*a,b);
Xif ((*b)[1] & 1) zadd(*a,*b,b);      z2div(*b,b); 
Xif (((*b)[1] & 1) == 0) zsub(*a,*b,b);		/* Odd square root */
X
Xzadd(sqkn,*b,&t1);        zdiv(t1,*a,&t1,&t2);
Xz2div(t1,&t1);                roots[0].r1 = -t1[1];
Xzsub(sqkn,*b,&t1);        zdiv(t1,*a,&t1,&t2);
Xz2div(t1,&t1);                roots[0].r2 = t1[1];
X 
X#ifdef NO_SQRTKN
Xfseek (restart, sqrtknbase, SEEK_SET);
X/* Skip over beginning of table. */
Xfor (i=1; i < nbsmallpsp; i++) fscanf(restart,NOSPNUM,&sqrtkni);
X#endif
X
Xfor (i=nbsmallpsp; i<=sizefacbase; i++) {
X#ifdef NO_SQRTKN
X	fscanf(restart,NOSPNUM,&sqrtkni);
X#endif
X	zintoz( (p = primbase[i]), &pp);
X	bp = zsmod(*b,p);
X	ap = zsmod(startd,p);
X	ap = zmulmods(ap,ap,p);	/* a mod p (a = d^2) */
X	if (ap != 0) {
X                bpc = bp;
X#ifdef NO_SQRTKN
X                if ((bp += sqrtkni) >= p) bp -= p;
X#else
X                if ((bp += sqrtkn[i]) >= p) bp -= p;
X#endif
X                ap = zinvodds(2*ap,p);
X                roots[i].r1 = zmulmods(p-ap, bp, p);
X#ifdef NO_SQRTKN
X                if ((bp = sqrtkni-bpc) < 0) bp += p;
X#else
X                if ((bp = sqrtkn[i]-bpc) < 0) bp += p;
X#endif
X                roots[i].r2 = zmulmods(ap, bp, p);
X        } else {
X                zsq(*b,&t1);
X                if (zcompare(kn,t1) >= 0) zsub(kn,t1,&t1);
X                else { zsub(t1,kn,&t1); bp = p-bp; }
X                zrshift(t1,(long)2,&t1);                zdiv(t1,*a,&t2,&t1);
X                zintoz(zsmod(t2,p),&ro1);
X                zintoz(zinvodds(bp,p),&ro2);        zmulmod(ro1,ro2,pp,&ro1);
X                roots[i].r2 = (roots[i].r1 = ro1[1]);
X	}
X}
X}
X 
Xcheckroot(a,b)
X/* This one could be done much nicer, but it is not important */
X/* if CHECK has a reasonably large value */
Xverylong a, b;
X{ long i, misser, p, minc;
Xstatic verylong r=0, c=0;
Xmisser = 0;
X
X#ifdef NO_SQRTKN
X  fseek (restart, sqrtknbase, SEEK_SET);
X#endif
X
Xfor (i=1; i<=sizefacbase; i++) {
X	p = primbase[i];     if (p < MAXSMALLPRIME) p = smallprimes[p];
X#ifdef NO_SQRTKN
X	fscanf(restart,NOSPNUM,&sqrtkni);
X        if (zsmod(kn,p) != zmulmods(sqrtkni, sqrtkni, p))
X#else
X        if (zsmod(kn,p) != zmulmods(sqrtkn[i], sqrtkn[i], p))
X#endif
X
X                { printf("Wrong at primbase[%ld]=%ld\n",i,p);
X                fflush(stdout);
X                misser ++; }
X        }
Xif (misser == 0) printf("squareroots correct\n");
Xelse printf("%ld mistakes in the squareroots\n",misser);
Xfflush(stdout);
X 
Xzsq(b,&r);
Xif (zcompare(kn,r) >= 0) { zsub(kn,r,&r); minc = -1; }
Xelse { zsub(r,kn,&r); minc = 1; printf("b is very large!\n"); }
Xif ((r[1]&3) != 0)  {
X        printf("kn-b^2 is not 0 modulo 4, error, exit\n");
X        exit(0);
X        }
Xzrshift(r,(long)2,&r);
Xzdiv(r,a,&c,&r);
Xif ((r[0] != 1 ) || (r[1] != 0)) {
X        printf("kn-^2 not divisible by a, error, exit\n");
X        exit(0);
X        }
X 
Xmisser = 0;
Xfor (i=nbsmallpsp; i<=sizefacbase; i++) {
X	long ap, bp, cp, res1, res2;
X	long root1 = roots[i].r1, root2 = roots[i].r2;
X        p = primbase[i];        if (p <= MAXSMALLPRIME) p = smallprimes[p];
X        ap = zsmod(a,p);
X        bp = zsmod(b,p);
X	cp = minc*zsmod(c,p);
X	res1 = zmulmods(ap, root1, p) + bp;
X	res2 = zmulmods(ap, root2, p) + bp;
X	if (res1 >= p) res1 -= p;
X	if (res2 >= p) res2 -= p;
X	res1 = zmulmods(res1, root1, p) + cp;
X	res2 = zmulmods(res2, root2, p) + cp;
X        if (res1 != 0 && res1 != p) {
X                misser ++;
X                printf("wrong first root at i=%ld p=%ld\n",i,p);
X                printf("ap=%ld, bp=%ld, cp=%ld, root=%ld\n", ap,bp,cp,root1);
X#ifdef NO_SQRTKN
X                printf("sqrtkn mod p = %ld, (2a)^-1 mod p = %ld\n",sqrtkni,
X			zinvodds(2*ap,p));
X#else
X                printf("sqrtkn mod p = %ld, (2a)^-1 mod p = %ld\n",sqrtkn[i],
X                        zinvodds(2*ap,p));
X#endif
X                fflush(stdout);
X                }
X        if (root1 == root2) printf("double root at p=%ld\n",p);
X        if (res2 != 0 && res2 != p) {
X                misser ++;
X                printf("wrong second root at i=%ld p=%ld\n",i,p);
X                printf("ap=%ld, bp=%ld, cp=%ld, root=%ld\n",ap,bp,cp,root2);
X#ifdef NO_SQRTKN
X                printf("sqrtkn mod p = %ld, (2a)^-1 mod p = %ld\n",
X	       		sqrtkni,zinvodds(2*ap,p));
X#else
X                printf("sqrtkn mod p = %ld, (2a)^-1 mod p = %ld\n",
X                        sqrtkn[i],zinvodds(2*ap,p));
X#endif
X                fflush(stdout);
X                }
X        }
Xif (misser == 0) printf("roots correct\n");
Xelse {
X        printf("%ld mistakes in the roots, exit\n",misser);
X        exit(0);
X        }
Xfflush(stdout);
X}
X 
X#ifndef RISC
X#if !(ASM_sieveinit)
Xsieveinit(lng, inval) /* use that sizeof(long) = 2^LOGLONGSIZE*/
Xlong lng, inval;
X{
Xregister long val = inval, i = (lng + (1<<LOGLONGSIZE) - 1) >> LOGLONGSIZE, *psiev = (long*)sieve;
Xwhile (i >= 100) {	/* Do 100 longwords at at time */
X	i -= 100;
X        *psiev++ = val; *psiev++ = val; *psiev++ = val; *psiev++ = val;
X        *psiev++ = val; *psiev++ = val; *psiev++ = val; *psiev++ = val;
X        *psiev++ = val; *psiev++ = val; *psiev++ = val; *psiev++ = val;
X        *psiev++ = val; *psiev++ = val; *psiev++ = val; *psiev++ = val;
X        *psiev++ = val; *psiev++ = val; *psiev++ = val; *psiev++ = val;
X        *psiev++ = val; *psiev++ = val; *psiev++ = val; *psiev++ = val;
X        *psiev++ = val; *psiev++ = val; *psiev++ = val; *psiev++ = val;
X        *psiev++ = val; *psiev++ = val; *psiev++ = val; *psiev++ = val;
X        *psiev++ = val; *psiev++ = val; *psiev++ = val; *psiev++ = val;
X        *psiev++ = val; *psiev++ = val; *psiev++ = val; *psiev++ = val;
X        *psiev++ = val; *psiev++ = val; *psiev++ = val; *psiev++ = val;
X        *psiev++ = val; *psiev++ = val; *psiev++ = val; *psiev++ = val;
X        *psiev++ = val; *psiev++ = val; *psiev++ = val; *psiev++ = val;
X        *psiev++ = val; *psiev++ = val; *psiev++ = val; *psiev++ = val;
X        *psiev++ = val; *psiev++ = val; *psiev++ = val; *psiev++ = val;
X        *psiev++ = val; *psiev++ = val; *psiev++ = val; *psiev++ = val;
X        *psiev++ = val; *psiev++ = val; *psiev++ = val; *psiev++ = val;
X        *psiev++ = val; *psiev++ = val; *psiev++ = val; *psiev++ = val;
X        *psiev++ = val; *psiev++ = val; *psiev++ = val; *psiev++ = val;
X        *psiev++ = val; *psiev++ = val; *psiev++ = val; *psiev++ = val;
X        *psiev++ = val; *psiev++ = val; *psiev++ = val; *psiev++ = val;
X        *psiev++ = val; *psiev++ = val; *psiev++ = val; *psiev++ = val;
X        *psiev++ = val; *psiev++ = val; *psiev++ = val; *psiev++ = val;
X        *psiev++ = val; *psiev++ = val; *psiev++ = val; *psiev++ = val;
X        *psiev++ = val; *psiev++ = val; *psiev++ = val; *psiev++ = val;
X        }
Xwhile (i > 0) {*psiev++ = val; i--;}
X}
X#endif /*not RISC*/
X#endif /* ASM_sieveinit */
X
Xdumpfac(w,wid,widc,ind,fac,bp,bp2,qi)
Xlong *w, ind; verylong fac; long bp, bp2; verylong qi;
Xchar wid[], widc[]; {
X	register long i;
X        int status;
X 
X	if ((mailit = fopen(nameoutput,"a+")) == NULL) {
X	      printf("Cannot open file %s.\n",nameoutput);
X	      printf("results to standard output\n");
X	      mailit = stdout; closeit = 0;
X	   }
X	
X    	(*w) ++;
X	fprintf(mailit,"%c%c%c %ld from %d\n",wid[0],wid[1],wid[2],*w,unique);
X	fprintf(mailit,"%s%ld %ld %ld",wid,bp,bp2,ind);
X    	for (i=1;i<=ind;i++) {
X            	if (i%10 ==0) fprintf(mailit,"\n%s",widc);
X            	fprintf(mailit," %ld",fac[i]);
X	}
X		fprintf(mailit,"\n%s 0 ",widc);
X		zfwrite(mailit,qi,LINELENGTH,"",widc);
X	
X	fprintf(mailit,"\n");
X 	fflush(mailit);
X	if (closeit) fclose(mailit);
X	if (++outputcounter == MAILBATCH && tobemailed) {
X		outputcounter = 0;
X		printf("executing %s",callsendit); timestamp();
X		status = system(callsendit);
X#ifdef VMS
X		if ((status & 01) != 1)
X#else
X                if (status)
X#endif
X                    printf("mail failed '%s' (status = %d)\n",
X                            callsendit, status);
X		else
X		    /* delete only if mail worked */
X		    unlink(nameoutput);
X	}
X	numfac += ind/2;
X 
X}
X
Xlong
Xtry_ecm(
X	verylong a,
X	verylong *f1,
X	verylong *f2)
X{
X	static long *r = 0;
X	ecc ++;
X	if (zecm(a,f1,0,10,100,1,0)) {
X		zdiv(a,*f1,f2,&r);
X		ecs ++;
X		return(1);
X	}
X	return(0);
X}
X
Xlong is_sq(n) long n; 
X{
X/* 
X   Test whether n is a perfect square.
X   If so, return its square root.  If not, return -1.
X
X   Optimized for case where most arguments will be non-squares.
X   (Peter Montgomery)
X*/
X   static int first = 1;
X   static unsigned char squtab[667]; /* Quadratic residues for primes <= 53 */
X   register long nn = n;
X#define MSK371 1
X#define MSK517 2
X#define MSK559 4
X#define MSK589 8
X#define MSK615 16
X#define MSK629 32
X#define MSK667 64
X   if (first) {
X	register long i;
X	first = 0;
X	for (i = 0; i < 667; i++) squtab[i] = 0;
X	for (i = 0; i < 334; i++) {
X	    register long isq = i*i;
X	    squtab[isq%371] |= MSK371;  squtab[isq%517] |= MSK517;
X	    squtab[isq%559] |= MSK559;  squtab[isq%589] |= MSK589;
X	    squtab[isq%615] |= MSK615;  squtab[isq%629] |= MSK629;
X	    squtab[isq%667] |= MSK667;  /* Initialize quadratic residues */
X	}
X   } 
X   if (nn < 0) return -1;
X   if (nn < 1) return nn;
X   while ((nn & 3) == 0 ) nn >>= 2;
X   if (    (nn & 7) == 1             && (squtab[nn%371] & MSK371)
X	&& (squtab[nn%517] & MSK517) && (squtab[nn%559] & MSK559)
X	&& (squtab[nn%589] & MSK589) && (squtab[nn%615] & MSK615)
X	&& (squtab[nn%629] & MSK629) && (squtab[nn%667] & MSK667)) {
X		/* Checks modulo all primes <= 53 */ 
X	long root = zsqrts(n);
X        if (n == root*root) return root;
X	return -1;
X   } else {
X	return -1;
X   }
X#undef MSK371
X#undef MSK517
X#undef MSK559
X#undef MSK589
X#undef MSK615
X#undef MSK629
X#undef MSK667
X}
X
Xlong
Xsquf(
X	verylong n,
X	verylong *f1,
X	verylong *f2)
X{
X#define MSD	30
X	static long *t1=0, *t2=0;
X	register long iter, nsqroot, Qprev, Qnow, Pnow, iterbnd=50000;
X	register long den_bound, nsmallden=0, donethat=0;
X	long smalldens[MSD];
X	int phase = 1;
X	if (zsqrt(n,&t1,&t2)) {
X		zcopy(t1,f1); zcopy(t1,f2); return(1);
X	}
X	Qnow = t2[1]; nsqroot = t1[1]; Pnow = nsqroot; Qprev = 1;
X	den_bound = zsqrts(2*nsqroot+1);
X	for (iter = 1; iter <iterbnd; iter++) {
X		long Pprev = Pnow, Qback2 = Qprev, root, den;
X		Qprev = Qnow;
X		if (nsqroot + Pprev >= 2*Qprev) {
X			long quot = (nsqroot + Pprev)/Qprev;
X			Pnow = quot * Qprev -Pprev;
X			Qnow = Qback2 + quot*(Pprev-Pnow);
X		} else {
X			Pnow = Qprev - Pprev; Qnow = Qback2+Pprev-Pnow;
X		}
X		den = Qprev;
X		if ((den & 1) == 0) den >>= 1;
X		if (Pnow == Pprev) {
X			zintoz(den,f1);
X			if (zsdiv(n,den,f2)) {
X				/* printf("error 3 in squf\n"); */
X				goto doecm;
X			}
X			return(iter);
X		}
X		if (phase && den<den_bound && den >1) {
X			if (nsmallden <MSD) {
X				smalldens[++nsmallden] = den;
X			} else {
X				/* printf("Increase MSD\n"); */
X				goto doecm;
X			}
X		}
X		if (phase && (iter & 1) && ((root=is_sq(Qnow)) > 0)) {
X			register long j = nsmallden;
X			smalldens[0] = root;
X			while (smalldens[j] != root) j--;
X			if (root == 1) { goto doecm;
X			} else if (j == 0 ) {
X				phase = 0;
X				if (donethat) {
X					goto doecm;
X				}
X				iterbnd += iter;
X				donethat = 1;
X				Pnow = nsqroot - (nsqroot-Pnow)%root;
X				zintoz(Pnow,&t1);
X				zsq(t1,&t2);
X				zsub(n,t2,&t2);
X				if (zsdiv(t2,root,&t1)) {
X					/* printf("error in squf\n"); */
X					goto doecm;
X				}
X				Qnow = t1[1];
X				Qprev = root;
X			}
X		}
X	}
X	doecm:
X	return(try_ecm(n,f1,f2));
X}
X
Xlong
Xfactor_attempt(
X	verylong a,
X	verylong *f1,
X	verylong *f2)
X{
X	register long i;
X	i=squf(a,f1,f2);
X	if (i) {
X		if (zcompare(a,*f1) && zcompare(a,*f2)) {
X			if (zcompare(*f1,*f2)>0)
X				zswap(f1,f2);
X			return(1);
X		}
X	}
X	return(0);
X}
X 
Xsievget(a,b,d2inv,sign,i,rshift,value)
Xverylong a, b, d2inv;
Xlong sign,i,rshift;
Xuchar value;
X{
Xstatic verylong qisq=0, t1=0, t2=0, t3=0;
Xlong factors[MAXFACNB], index = 1;
X/*
X	Set P(X) = ((2*a*x + b)^2 - kn)/4*d^2, where a = d^2
X	(see findnextpolynomial).  sievget is called when
X	siever detects that P(i) is highly composite.
X	This routine computes P(i) explicitly and possibly
X	outputs a relation containing qisq = (2*a*i + b)/2d
X	and the factors of P(i) == qisq mod kn.
X*/
X
Xcloseit = 1;
Xzsmul(a,2*(i > 0 ? i : -i),&t1);
Xif (i > 0) zadd(t1,b,&t1);
Xelse if (zcompare(t1,b) >= 0) zsub(t1,b,&t1);
Xelse zsub(b,t1,&t1);		/* t1 = +- (2*a*i + b) */
Xzmulmod(t1,d2inv,kn,&qisq);	
Xzmulmod(qisq,qisq,kn,&t1);
Xif (i>=roots[0].r1 && i<=roots[0].r2) { factors[1]= -1;  zsub(kn,t1,&t1); }
Xelse factors[1]=1;
X{
X	register long j;
X	double contrib = 0.0;
X
X	for (j=1;j<=nbsmallps;j++) {
X		long pj = primbase[j];
X		if (!(zsdiv(t1,pj,&t2))) {
X			long cntr = 1;
X			zcopy(t2,&t1); cntr=1;
X			while (!(zsdiv(t1,pj,&t2))) {
X				cntr ++; zcopy(t2,&t1);
X			}
X			contrib += (double)cntr*smlogp[j];
X			factors[++index] = cntr;
X			factors[++index] = j;
X		}
X	} /* for j */
X	if ((double)value+contrib < (double)sievebound) return;
X}
X{
X	register long j;
X	register long offset = i - rshift;	/* negative */
X	register roots_t *loc_roots = roots;
X	register row      loc_primbase = primbase;
X	register long     loc_sizefacbase = sizefacbase;
X
X	for (j = nbsmallpsp; j <= loc_sizefacbase; j++) {
X		register long imodp = offset;
X		register long pj = loc_primbase[j];
X/*
X		Test whether roots[j].r1 - offset or
X		roots[j].r1 + roots[j].r2 - offset
X		is divisible by pj.  Recall offset < 0 and
X		0 <= roots[j].r1 <= roots[j].r1 + roots[j].r2 < p .
X		Ensure that first argument to % is nonnegative.	
X*/
X		if (imodp <= -(pj << 3)) {
X			imodp = pj - 1 - (-1 - imodp)%pj;
X		} else {	/* quotient at most 8, often much less */
X			do {} while ((imodp += pj) < 0);
X		}
X		imodp -= loc_roots[j].r1;
X        	if (imodp == 0 || imodp == loc_roots[j].r2) {
X                	if (!(zsdiv(t1,pj,&t2))) {
X				long cntr = 1;
X				zcopy(t2,&t1);
X				while (!(zsdiv(t1,pj,&t2))) {
X					cntr ++; zcopy(t2,&t1);
X				}
X				if (index >= MAXFACNB-2) {
X				    printf("Increase MAXFACNB\n");
X				    return; 
X				}
X				factors[++index] = cntr;
X				factors[++index] = j;
X			} else {
X				printf("Sievget - bad root, p = %ld\n", pj);
X			}
X		} /* if imodp */
X	} /* for j */
X}
X{
X	long ival= (long)value;
X	double t1value;
X	int lucky;
X
X	if (t1[0] > 2) {
X		lac ++;
X		lucky = 0;		/* Cofactor too large */
X	} else if (t1[0] == 1) {
X		long pj = t1[1];
X		if (pj == 1) {
X			dumpfac(&ful,fulid,fulidc,index,factors,1L,1L,qisq);
X                	if (ival>maxful) maxful = ival;
X               		if (ival<minful) minful = ival;
X               		sumful += ival;
X		} else { /* pj */
X			/* believe pj is prime, even */
X			/* if it isn't. who cares, it */
X			/* doesn't matter */
X 
X			dumpfac(&par,parid,paridc,index,factors,1L,pj,qisq);
X               		if (ival>maxpar) maxpar = ival;
X               		if (ival<minpar) minpar = ival;
X               		sumpar += ival;
X		}
X		lucky = 1;
X	} else if (   (t1value = zdoub(t1))
X		    < (double)lastprime*(double)lastprime) {
X		prc ++;
X		lucky = 0;		/* Cofactor must be prime */
X	} else if (zprime(t1,(long)1,2)) { /* then we believe t1 is prime */
X		prc ++;
X		lucky = 0;
X	} else { /* now t1 has precisely two factors */
X			/* is it pp or worthless? */
X			/* let's first try to factor it */
X		if (factor_attempt(t1,&t2,&t3)) {
X			/* smallest in t2, largest in t3 */
X			if (   t3[0]>1 || t2[0]>1 ) {
X				woc ++;
X				lucky = 0;
X			} else {	/* now they are both small enough */
X		    		if (t2[1] <= lastprime) {
X					printf("Sievget - missed f = %ld\n",
X						t2[1]);
X				}
X				/* the pp case */
X				dumpfac(&ppr,pprid,ppridc,index,
X					factors,t2[1],t3[1],qisq);
X                		if (ival>maxppr) maxppr = ival;
X				if (ival<minppr) minppr = ival;
X				sumppr += ival;
X				lucky = 1;
X			}
X		} else {
X			/*
X			printf("Missed factorization: ");
X			zwriteln(t1); fflush(stdout);
X			*/
X			mic ++;
X			lucky = 0;
X		}
X	} /* end of ifs over t1 */
X 
X	if (!lucky) {
X#if MAXPOL <= 100
X		printf("                 unfactored quotient %3ld: ", ival);
X		zwrite(t1); printf("\n"); fflush(stdout);
X#endif
X		bad ++;
X		if (ival>maxbad) maxbad = ival;
X		if (ival<minbad) minbad = ival;
X		sumbad += ival;
X	}
X}
X} /* sievget */
X
X#if ASM_first_ge
Xlong first_ge();
X#else
Xlong first_ge(array, start, lower_bound)
X/* Return index of first element in array which is >= lower_bound. */
X/* Should be optimized for case where very few elements are >= lower_bound. */
Xlong start;
Xuchar array[], lower_bound;
X{
X    register uchar *parray = &array[start];
X    register uchar  bound  = lower_bound;
X    if (sizeof(long) == 4*sizeof(uchar) & FIRST_GE_SENTINEL >= 4) {
X/* Advance to longword boundary (N.B. array was allocated by malloc) */
X	do {
X	    if (*parray >= bound) return (parray-array);
X        } while ((++parray - array)&3);
X/* Check four bytes at a time. */
X/* If something interesting found, complete search one byte at a time. */
X/* This attempts to cater to both big-endian and little-endian machines. */
X	{ register long long_bound = (0x01010101)*(bound - 1);
X	  register long *plarray = (long*)(parray);
X 
X	  while (
X	    (((long_bound - plarray[0])
X	    | (long_bound - plarray[1])
X	    | (long_bound - plarray[2])
X	    | (long_bound - plarray[3]))
X	    & 0x80808080) == 0)
X		plarray += 4;
X 
X	  parray = (uchar*)(plarray);
X/*
X	printf("first %ld\n",(long)(parray-1-array));
X	  printf("plarray = %lx, parray = %x %x %x %x, bound=%x\n",
X	    plarray[-1], parray[0], parray[1], parray[2], parray[3],bound);
X	  fflush(stdout);
X*/
X	}
X    }
X    while (*parray++ < bound) {};	/* null body */
X/*
X	printf("final %ld\n",(long)(parray-1-array));
X	  fflush(stdout);
X*/
X 
X    return (parray-1-array);
X}
X#endif 	/* ASM_first_ge */
X 
X/* sievget_check checks for elements of sieve which are >= smallsievebnd */
X#define sievget_check(direction,shifter) {i = -1; \
X	sieve[rsl] = smallsievebnd; \
X        while ((i = first_ge(sieve, i+1, smallsievebnd)) < rsl) {\
X            sievget(a,b,d2inv,(long)(direction),i+ishift,\
X			(long)(shifter),sieve[i]);}}
X 
X/*
X	Procedures bigp_siever, lowp_siever, medp_siever
X	all have four arguments (ibeg, iend, rsl, logp).
X	Each sieves for all primes p = primbase[i],
X	where ibeg <= i <= iend, by adding logp
X	to all appropriate entries of the sieve.
X	All assume the new roots are roots[i].r1 and
X	roots[i].r1 + roots[i].r2, where
X
X		0 <= roots[i].r1 <= roots[i].r1 + roots[i].r2 <= p-1
X
X	The difference is the range of values of p
X	assumed by each procedure:
X
X		bigp_siever -- p >= rsl          (at most one hit per root)
X		lowp_siever -- p <= rsl/2        (at least two hits per root)
X		medp_siever -- rsl/2 <= p <= rsl (one or two hits per root)
X*/
X
X
X#if !(ASM_bigp_siever)
Xbigp_siever(ibeg, iend, rsl, logp)
Xlong ibeg;	/* lower bound on i for sieving */
Xlong iend;	/* upper bound on i for sieving */
Xlong rsl;	/* width of sieve interval */
Xuchar logp;	/* logarithm of these primes */
X{
X    register long loc_rsl = rsl, i;
X    register uchar loc_logp = logp;
X    register urow sieve_rsl = sieve + loc_rsl;
X    register roots_t *rootsi = roots + ibeg;
X    register row pi = primbase + ibeg;
X
X    for (i = ibeg - iend - 1; i < 0; i++) {
X	register long root1 = rootsi->r1 - loc_rsl;
X				/* root relative to end of sieve interval */
X#if 0
X	if (   rootsi->r1< 0 || rootsi->r2 < 0
X	    || rootsi->r1 + rootsi->r2 >= *pi || *pi < loc_rsl) {
X	    printf("Bad r1 = %ld, r2 = %ld, bigp = %ld\n",
X		rootsi->r1, rootsi->r2, *pi);
X	}
X#endif
X	if (root1 < 0) {	
X	    register long root2 = root1 + rootsi->r2;
X
X	    sieve_rsl[root1] += loc_logp;
X	    root1 += *pi;	     /* Advance smaller root by p */
X	    if (root2 < 0) {
X		sieve_rsl[root2] += loc_logp;
X					     /* Difference unchanged */
X	    } else {
X		rootsi->r2 = root1 - root2;  /* New difference */
X		root1 = root2;		     /* New smaller root */
X	    }
X	}
X	rootsi->r1 = root1;
X	rootsi++;
X	pi++;
X    }	/* for i */
X}
X#endif	/* ASM_bigp_siever */
X
X#if !(ASM_lowp_siever)
Xlowp_siever(ibeg, iend, rsl, logp)
Xlong ibeg;	/* lower bound on i for sieving */
Xlong iend;	/* upper bound on i for sieving */
Xlong rsl;	/* width of sieve interval */
Xuchar logp;	/* logarithm of these primes */
X{
X             long loc_rsl = rsl;
X    register long i;
X    register urow sieve_rsl = sieve + loc_rsl, sieve1;
X    register uchar loc_logp = logp;
X    register roots_t *rootsi = roots + ibeg;
X    register row pi = primbase + ibeg;
X
X    for (i = ibeg - iend - 1; i < 0; i++) {
X	register long rootdif = rootsi->r2;
X	register long root2 = rootsi->r1 - loc_rsl + rootdif;
X			/* larger root relative to end of sieve interval. */
X			/* Will always be negative initially */
X	register long p = *pi++;
X
X#if 0
X	if (   rootsi->r1 < 0 || rootdif < 0
X	    || rootsi->r1 + rootdif >= p || p+p > loc_rsl) {
X	    printf("Bad r1 = %ld, r2 = %ld, lowp = %ld\n",
X			rootsi->r1, rootdif, p);
X	}
X#endif
X 
X	sieve1 = sieve_rsl - rootdif;
X			/* Note  sieve1  = sieve + (rsl-p) + (p-rootdif)
X					>= sieve,
X			   as required by ANSI C. */
X	do {
X	    sieve1[root2] += loc_logp; sieve_rsl[root2] += loc_logp;
X	    root2 += p;	
X	    sieve1[root2] += loc_logp; sieve_rsl[root2] += loc_logp;
X	    root2 += p;	
X	} while (root2 < -p);
X	if (root2 < 0) {
X	    sieve1[root2] += loc_logp; sieve_rsl[root2] += loc_logp;
X	    root2 += p;	
X	}	
X	root2 -= rootdif;		/* Replace root2 by smaller root */
X	if (root2 < 0) {		/* Extra hit for smaller root */
X	    sieve_rsl[root2] += loc_logp;
X	    root2 += rootdif;		/* Restore previous value */
X	    rootsi->r2 = p - rootdif;  	/* New difference */
X	}
X	rootsi->r1 = root2;		/* New smaller root */
X	rootsi++;
X    }	/* for i */
X}
X#endif	/* ASM_lowp_siever */
X
X#if !(ASM_medp_siever)
Xmedp_siever(ibeg, iend, rsl, logp)
Xlong ibeg;	/* lower bound on i for sieving */
Xlong iend;	/* upper bound on i for sieving */
Xlong rsl;	/* width of sieve interval */
Xuchar logp;	/* logarithm of these primes */
X{
X    register long loc_rsl = rsl, i;
X    register uchar loc_logp = logp;
X    register urow sieve_rsl = sieve + loc_rsl;
X    register roots_t *rootsi = roots + ibeg;
X    register row pi = primbase + ibeg;
X
X    for (i = ibeg - iend - 1; i < 0; i++) {
X	register long root1 = rootsi->r1 - loc_rsl;
X	register long root2 = root1 + rootsi->r2;
X	register long p = *pi++;
X				/* roots relative to end of sieve interval */
X/*
X		This code resembles that in bigp_siever, except we
X		sieve at least once per root.
X*/
X
X#if 0
X	if (   rootsi->r1 < 0 || rootsi->r2 < 0
X	    || rootsi->r1 + rootsi->r2 >= p
X	    || p+p < loc_rsl || p > loc_rsl) {
X	    printf("Bad r1 = %ld, r2 = %ld, medp = %ld\n",
X		rootsi->r1, rootsi->r2, p);
X	}
X#endif
X	sieve_rsl[root1] += loc_logp;
X	sieve_rsl[root2] += loc_logp;
X	root1 += p;
X	if (root1 < 0) {	
X	    sieve_rsl[root1] += loc_logp;
X	    root1 += p;	     		/* Advance smaller root by p */
X	    root2 += p;	
X	    if (root2 < 0) {
X		sieve_rsl[root2] += loc_logp;
X					     /* Difference unchanged */
X	    } else {
X		rootsi->r2 = root1 - root2;  /* New difference */
X		root1 = root2;		     /* New smaller root */
X	    }
X	}
X	rootsi->r1 = root1;
X	rootsi++;
X    }	/* for i */
X}
X#endif /* ASM_medp_siever */
X
Xlong prim_atmost(p)
Xlong p;
X{
X/*
X	Return the largest index i such that primbase[i] <= p.
X	Use a binary search.  We treat primbase[0] as -infinity
X	and primbase[sizefacbase+1] as +infinity.
X*/
X    register long mn = 0, mx = sizefacbase;
X    while (mx != mn) {
X		/* primbase[mn] <= p < primbase[mx+1] */
X	register long mid = (mn + mx + 1) >> 1;
X	if (primbase[mid] > p) {
X	    mx = mid - 1;
X	} else {
X	    mn = mid;	
X	}
X    } /* while */
X    return mn;
X}
X
X#if !(ASM_sieveroot_adjust)
Xsieveroot_adjust(amt)
Xlong amt;	/* assumed nonnegative */
X{
X/*
X	findnextpolynomial stored the roots of a*x^2 + b*x + c mod p
X	into r1 and r2, in arbitrary order.  That is also the
X	convention used in checkroot.  Add (amt % p) to these
X	roots, keeping them in [0, p-1).  Then store the smaller root
X	in r1 and the difference in r2 (a convention used in
X	bigp_siever, lowp_siever, medp_siever, and sievget).
X
X*/
X    register row          pi       = &primbase[nbsmallpsp];
X    register roots_t *rootsi       =    &roots[nbsmallpsp];
X    register roots_t *rootsi_bound =    &roots[sizefacbase];
X
X    for (; rootsi <= rootsi_bound; rootsi++) {
X        register long p     = *pi++;
X        register long srem  = amt % p;
X        register long root1 = rootsi->r1 + srem;
X        register long root2 = rootsi->r2 + srem;
X
X        if (root1 >= p) root1 -= p;	/* Ensure in [0, p-1) */
X        if (root2 >= p) root2 -= p;
X
X        if (root1 < root2) {	
X	    rootsi->r1 = root1;		/* smaller root */
X	    rootsi->r2 = root2-root1;	/* difference */
X        } else {
X	    rootsi->r1 = root2;
X	    rootsi->r2 = root1-root2;
X        }
X    } /* for rootsi */
X}
X#endif	/* ASM_sieveroot_adjust */
X
Xsiever(a,b,d2inv)
Xverylong a, b, d2inv;
X{
Xregister long i;
Xlong value = (primbase[1] == 2 ? BYTSOF1 : 0);
Xlong ishift;
Xlong rsl_prev = 0, rsl_crossing, rsl2_crossing;
X	/* primbase[rsl_crossing ] <= rsl   <= primbase[rsl_crossing+1 ] */
X	/* primbase[rsl2_crossing] <= rsl/2 <= primbase[rsl2_crossing+1] */
X
Xsieveroot_adjust(sievelength);	/* Add sievelength %p to roots */
X				/* (negative of initial ishift) */
X
Xfor (ishift = -sievelength; ishift < sievelength; ishift += sievesize) {
X	long  rshift =  (   ishift + sievesize < sievelength
X			  ? ishift + sievesize : sievelength);
X				/* right end of interval, plus 1 */
X	long  rsl = rshift - ishift;
X				/* width of current sieve interval */
X	register uchar logp;
X#ifdef RISC
X        for (i=0;i<rsl;i++) sieve[i] = value;
X#else
X        sieveinit(rsl,value);
X#endif
X
X	if (rsl != rsl_prev) {	/* Update rsl_crossing, rsl2_crossing  */
X	    rsl_prev = rsl;
X	    rsl_crossing  = prim_atmost(rsl     );
X	    rsl2_crossing = prim_atmost(rsl >> 1);
X	}
X
X        for (logp = firstlog; logp <= lastlog; logp++) {
X	    register long ibeg = logpstart[logp];
X	    long iendbig = logpstart[logp+1] - 1;
X	    long iendlow = (iendbig <= rsl2_crossing ? iendbig : rsl2_crossing);
X	    long iendmed = (iendbig <= rsl_crossing  ? iendbig : rsl_crossing );
X
X	    /* Sieve over primes  p <= rsl/2 with this logarithm */
X
X	    if (ibeg <= iendlow) {
X		lowp_siever(ibeg, iendlow, rsl, logp);
X		ibeg = iendlow + 1;
X	    }
X
X	    /* Sieve over primes p with rsl/2 < p <= rsl and this logarithm */
X
X	    if (ibeg <= iendmed) {
X		medp_siever(ibeg, iendmed, rsl, logp);
X		ibeg = iendmed + 1;
X	    }
X
X	    /* Sieve over primes p > rsl with this logarithm */
X
X	    if (ibeg <= iendbig) {
X		bigp_siever(ibeg, iendbig, rsl, logp);
X	    }
X        }   /* for logp */
X        sievget_check(1, rshift);
X        } /* for ishift */
X}
X
Xreport()
X{
X/*	
X	This report is produced at intervals specified by REPORT.
X	The output has one long line, resembling:
X
X	S40; F1=137; P2(126,113); p4(105,102.25,100);
X	B148(118,102.82,99); L13.86;12765946021730812111390339
X
X	S40  		    - 40 polynomials have been sieved.
X	F=137 		    - 1 full found by sievget, with ival = 137
X			      (ival is total logarithm from sieving).
X	P2(126,113) 	    - Two partials found, with ival = 126 and 113.
X	p4(105,102.25,100)  - Four double partials have been found,
X		  	      with largest ival = 105, smallest = 100,
X			      average = 102.25.
X	B148(118,102.82,99) - 148 false reports to sievget occurred,
X		  	      with largest ival = 118, smallest = 99,
X			      average = 102.82.
X	L13.86 		    - Average value of index on dumpfac call
X			      (divisors from factor base per relation) = 13.86.
X	12765946021730812111390339 - Latest startd for findnextpolynomial.
X*/
X
Xprintf("S%ld",pol);
Xif (ful > 0) {
X        if (ful == 1) printf("; F1=%ld",maxful);
X        else if (ful == 2) printf("; F2(%ld,%ld)",maxful,minful);
X        else printf("; F%ld(%ld,%.2f,%ld)",ful,maxful,
X                        (double)sumful/ful,minful);
X        }
Xif (par > 0) {
X        if (par == 1) printf("; P1=%ld",maxpar);
X        else if (par == 2) printf("; P2(%ld,%ld)",maxpar,minpar);
X        else printf("; P%ld(%ld,%.2f,%ld)",par,maxpar,
X                        (double)sumpar/par,minpar);
X        }
Xif (ppr > 0) {
X        if (ppr == 1) printf("; p1=%ld",maxppr);
X        else if (ppr == 2) printf("; p2(%ld,%ld)",maxppr,minppr);
X        else printf("; p%ld(%ld,%.2f,%ld)",ppr,maxppr,
X                        (double)sumppr/ppr,minppr);
X        }
Xif (bad > 0) {
X        if (bad == 1) printf("; B1=%ld",maxbad);
X        else if (bad == 2) printf("; B2(%ld,%ld)",maxbad,minbad);
X        else printf("; B%ld(%ld,%.2f,%ld)",bad,maxbad,
X                        (double)sumbad/bad,minbad);
X        }
Xif ((ful+par+ppr) > 0)
X	printf("; L%.2f",(double)numfac/(ful+par+ppr));
Xif (started > 0) {
X        printf(";");
X        if (interrupted > 0)
X                zwrite(altstartd);
X        else
X                zwrite(startd);
X        }
Xtimestamp();
X	printf("  prime %ld; ecm %ld(+%ld); mis %ld; bigfac %ld; large %ld\n",
X		prc,ecc,ecs,mic,woc,lac);
X	fflush(stdout);
X	fsync(fileno(stdout)); /* make sure bits get out */
X}
X 
Xvoid csaver() {
X    int status;
X
X    if (outputcounter &&( how == SLAVE )) {
X	if (tobemailed) {
X	    printf("mailing...\n");
X	    status = system(callsendit);
X#ifdef VMS
X	    if ((status & 01) != 1)
X#else
X            if (status)
X#endif
X		printf("mail failed '%s' (status = %d)\n", callsendit, status);
X	    else
X		unlink(nameoutput);   /* delete only if mail worked */
X	}
X	else printf("please mail %s to the factor account\n",nameoutput);
X    }
X    printf("Exit: ");
X    report();
X    exit(0);
X}
X
Xvoid sigtermexit() {
X        printf("caught TERM signal, exit"); timestamp();
X        csaver();
X        exit(0);
X}
X
Xvoid sigintexit() {
X        printf("caught INT signal, exit"); timestamp();
X        csaver();
X        exit(0);
X}
X
Xvoid sigstoppause() {
X        if (!signalinterrupt) {
X                printf("caught TSTP signal, pause"); timestamp();
X        }
X        kill(getpid(), SIGSTOP);
X        signalinterrupt = 1;
X}
X
Xvoid goagain() {
X        if (signalinterrupt) {
X                printf("caught CONT signal, continue"); timestamp();
X                signalinterrupt = 0;
X        }
X}
X
Xvoid setupsignals () {
X	signal(SIGTERM, sigtermexit);
X        signal(SIGINT, sigintexit);
X        signal(SIGTSTP, sigstoppause);
X        signal(SIGCONT, goagain);
X}
X 
Xiterate()
X{
Xstatic verylong a = 0, b = 0, d2inv = 0;
X 
Xsievesize = MAXSIEVE;
Xif (sievesize > sievelength) sievesize = sievelength;
Xif (sievesize < 400)  {
X        if ((sieve = (uchar*)malloc(luchar*(400+FIRST_GE_SENTINEL)))==NULL) {
X                printf("unable to get memory for sieve, exit\n");
X                exit(0);
X                }
X        }
Xelse {
X        while ((sieve=(uchar*)malloc(
X			luchar*(sievesize+FIRST_GE_SENTINEL)))==NULL) {
X                if ((sievesize -= MINSIEVE) < 0) {
X                      printf("unable to get memory for sieve, exit\n");
X                        exit(0);
X                        }
X                }
X        }
X 
Xfsync(fileno(stdout)); /* make sure bits get out */
X
Xfor (pol=1; pol<=MAXPOL; pol++)  {
X        findnextpolynomial(&a,&b,&d2inv);
X        if (how == SLAVE)
X                if (((pol%CHECK) == 0) /* || (pol == 1 ) */ ) checkroot(a,b);
X        siever(a,b,d2inv);
X        if ((pol%REPORT) == 0) report();
X        }
Xcsaver();
X}
X
X#ifdef VMS
Xunlink(filename)
X     char* filename;
X{
X  int status;
X  char unlink_command[100];
X  
X  sprintf(unlink_command, "DELETE %s.;", filename);
X  status = system(unlink_command);
X  if ((status & 01) != 1) {
X    printf("VMS delete failed '%s' (status = %d)\n",
X	   unlink_command, status);
X    fflush(stdout);
X  }
X}
X#endif /*VMS*/
X
X 
Xmain (argc, argv) char *argv[]; int argc; {
X#ifdef SYSV
X	setpgrp2(0,0);
X#endif
X        if (argc >= 4) {
X            restartfn = argv[1];
X            if (strcmp(argv[2], "-") && !freopen(argv[2], "r", stdin)) {
X		fprintf(stderr, "Can't open input file '%s'\n",  argv[2]);
X		exit(1);
X	    }
X            if (!freopen(argv[3], "a", stdout)) {
X		fprintf(stderr, "Can't open output file '%s'\n",  argv[3]);
X		exit(1);
X	    }
X        }
X        if (argc == 1)
X            restartfn = default_restart;
X        else {
X            restartfn = argv[1];
X            printf("Restart file is %s\n", restartfn);
X        } 
X        if (argc >= 5)
X            file_prefix = argv[4];
X        if (argc >= 6)
X            mail_cmd = argv[5];
X        fflush(stdout);
X        setupsignals();
X#ifdef NO_TIMING
X	timestart = 0.0;
X#else
X        getrusage (RUSAGE_SELF, &used);
X#if defined(sparc) && defined(__svr4__)
X        timestart = used.ru_utime.tv_sec + used.ru_utime.tv_nsec / 1e9;
X        timestart += used.ru_stime.tv_sec + used.ru_stime.tv_nsec / 1e9;
X#else
X        timestart = used.ru_utime.tv_sec + used.ru_utime.tv_usec / 1e6;
X        timestart += used.ru_stime.tv_sec + used.ru_stime.tv_usec / 1e6;
X#endif /* SOLARIS */
X#endif /* NO_TIMING */
X        scanf("%ld",&how);
X        setup();
X	/* Find where the logarithm changes.
X	*/
X	{
X    		register uchar logp = firstlog;
X    		logpstart[logp] = nbsmallpsp;
X    		while (1) {
X			long logbr = nextlog[logp-firstlog];
X			if (logbr > primbase[sizefacbase]) break;
X			logpstart[++logp] = prim_atmost(logbr-1) + 1;
X    		}
X    		lastlog = logp;
X    		logpstart[lastlog+1] = sizefacbase + 1;
X	}
X
X        iterate();
X}
X
END_OF_FILE
if test 58060 -ne `wc -c <'src/mpqs.c'`; then
    echo shar: \"'src/mpqs.c'\" unpacked with wrong size!
fi
# end of 'src/mpqs.c'
fi
if test -f 'src/sparc-solaris.s' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'src/sparc-solaris.s'\"
else
echo shar: Extracting \"'src/sparc-solaris.s'\" \(14636 characters\)
sed "s/^X//" >'src/sparc-solaris.s' <<'END_OF_FILE'
X#define NBITS 30	
X!	Assembly versions of selected  routines
X!
X!			bigp_siever	(mpqs.c)
X!			first_ge	(mpqs.c)
X!			lowp_siever	(mpqs.c)
X!			medp_siever	(mpqs.c)
X!			sieveinit	(mpqs.c)
X!
X!	Use -DCONTRIBUTION_8 when compiling mpqs.c.
X!
X!	If this file is named "foo.s", then assemble with
X!	"as -P -DFPU foo.s -o foo.o" if you have a floating-point
X!	coprocessor, and with "as -P foo.s foo.o" if you do not.
X!
X!	Contributed by
X!
X!			Peter L. Montgomery
X!			Department of Mathematics
X!			University of California
X!			Los Angeles, CA 90024
X!		
X!			pmontgom@math.ucla.edu
X!			June, 1990
X!^L
X#include <sys/asm_linkage.h>
X#define ASSEM_TRAPS 1
X		! ASSEM_TRAPS = 0 to omit execution-time checks
X		! ASSEM_TRAPS = 1 to minimal checking
X		! ASSEM_TRAPS = 2 for extensive checking
X
X!
X!		bigp_siever(ibeg, iend, rsl, logp)
X!
X!		rootsi = &roots[ibeg];
X!		end_primbase = &primbase[iend];
X!		sieve_rsl = sieve + rsl
X!		for (i = ibeg-iend; i <= 0;  i++, rootsi++) {
X!		    rootdif = rootsi->r2;
X!		    root1 = rootsi->r1 - rsl;
X!		    if (root1 < 0) {
X!			p = end_primbase[i];
X!			sieve_rsl[root1] += logp;
X!			root2 = root1 + rootdif
X!			if (root2 < 0) {
X!			    sieve_rsl[root2] += logp;
X!			    rootsi->r1 = root1 + p;
X!			} else {
X!			    rootsi->r1 = root2;
X!			    roots[i].r2 = p - rootdif;
X!			}
X!		    } else {
X!			rootsi->r1 = root1;
X!		    }
X!		} /* for i */
X#define ibeg %i0
X#define iend %i1
X#define rsl  %i2
X#define logp %i3
X#define I4 %i4
X			/* I4 = 4*i */
X#define root2 %l0
X#define rootdif %l1
X		/* root2, rootdif must be even-odd pair for ldd and std */
X#define root1 %l2
X#define end_primbase %l3
X#define sieve_rsl %l4
X#define rootsi	%l6
X#define temp1  %o0
X#define temp2  %o1
X#define temp3  %o2
X#define temp4  %o3
X#define p      %o4
X
X	.globl	bigp_siever		! bigp_siever(ibeg, iend, rsl, logp)
Xbigp_siever:
X	save	%sp,-WINDOWSIZE,%sp
X	subcc	ibeg,iend,I4			! ibeg - iend
X	bg	9f				! Exit if ibeg > iend
X	sll	I4,2,I4				! I4 = 4*(ibeg - iend) (delay)
X
X	set	primbase,end_primbase
X	set	roots,rootsi
X	set	sieve,sieve_rsl
X	ld	[end_primbase],end_primbase	! Load C pointer values
X	ld	[rootsi],rootsi
X	ld	[sieve_rsl],sieve_rsl
X	sll	iend,2,iend			! iend <- 4*iend
X	sll	ibeg,3,ibeg			! ibeg <- 8*ibeg
X	add	iend,end_primbase,end_primbase  ! &primbase[iend]
X	add	ibeg,rootsi,rootsi		! &roots[ibeg]	
X	ba	2f				! Enter outer loop
X	add	rsl,sieve_rsl,sieve_rsl		! &sieve[rsl] (delay)
X
X8:						! Come here if root2 < 0
X	ldub	[sieve_rsl+root2],temp2
X	stb	temp1,[sieve_rsl+root1]		! Update sieve_rsl[root1]
X	add	root1,p,root1			! root1 += p
X	add	temp2,logp,temp2
X	stb	temp2,[sieve_rsl+root2]		! Update sieve_rsl[root2]
X
X1:						! Come here if root1 >= 0
X	inccc	4,I4				! Increment 4*i
X	st	root1,[rootsi]			! roots[i].r1 = root1	
X	bg	9f				! Terminate if 4*i > 0
X	inc	8,rootsi			! Advance &roots[i] (delay)
X	
X2:						! Start of outer loop
X	ldd	[rootsi],root2			! root2 = roots[i].r1
X						! rootdif = roots[i].r2
X#if ASSEM_TRAPS > 1
X	/* Expect 0 <= roots[i].r1 <= roots[i].r1 + roots[i].r2 < p >= rsl */
X	tst root2;	tl  0			! Is 0 <= roots[i].r1?
X	tst rootdif;	tl  0			! Is 0 <= roots[i].r2?
X	ld	[end_primbase+I4],p		! p = end_primbase[i]
X	add root2,rootdif,temp1	
X	cmp temp1,p;    tge 0		! Is roots[i].r1 + roots[i].r2 < p?
X	cmp p,rsl;	tl  0			! Is p <= rsl?
X#endif
X	subcc	root2,rsl,root1			! root1 = roots[i].r1 - rsl
X	bge	1b				! Branch if root1 >= 0
X	addcc	root1,rootdif,root2	   ! root2 = root1 + rootdif (delay)
X
X	ldub	[sieve_rsl+root1],temp1
X	ld	[end_primbase+I4],p		! p = end_primbase[i]
X	bl	8b				! Branch if root2 >= 0
X	add	temp1,logp,temp1		! (delay)
X
X	sub	p,rootdif,rootdif		! p - rootdif
X	stb	temp1,[sieve_rsl+root1]		! Update sieve_rsl[root1]
X	inccc	4,I4				! Increment 4*i
X	std	root2,[rootsi]			! roots[i].r1 = root2
X						! roots[i].r2 = p - rootdif
X	ble	2b				! Continue if 4*i <= 0
X	inc	8,rootsi			! Advance @roots[i] (delay)
X
X9:
X	ret					! Exit
X	restore					! (delay)	
X
X#undef ibeg
X#undef iend
X#undef rsl
X#undef I4
X#undef logp
X#undef root1
X#undef end_primbase
X#undef sieve_rsl
X#undef rootsi
X#undef temp1
X#undef temp2
X#undef temp3
X#undef temp4
X#undef p
X!
X!		lowp_siever(ibeg, iend, rsl, logp)
X!
X!		rootsi = &roots[ibeg];
X!		end_primbase = &primbase[iend];
X!		sieve_rsl = sieve + rsl
X!		for (i = ibeg-iend; i <= 0;  i++, rootsi++) {
X!		    p = end_primbase[i];
X!		    rootdif = rootsi->r2;
X!		    root2 = rootsi->r1 - rsl + rootdif;
X!		    sieve1 = sieve_rsl - rootdif;
X!		    root2p = root2 + p
X!		    do {
X!			sieve1   [root2 ] += logp;
X!			sieve_rsl[root2 ] += logp;
X!			sieve1   [root2p] += logp;
X!			sieve_rsl[root2p] += logp;
X!			root2  += 2*p;
X!			root2p += 2*p
X!		    } while (root2p < 0);
X!		    if (root2 < 0) {
X!			sieve1   [root2] += logp;
X!			sieve_rsl[root2] += logp;
X!			root2 += p;
X!		    }
X!		    root1 = root2 - rootdif;
X!		    if (root1 < 0) {
X!			sieve_rsl[root1] += logp;
X!			rootsi->r1 = root2;		/* Smaller new root */
X!			rootsi->r2 = p - rootdif;	/* New difference */
X!		    } else {
X!			rootsi->r1 = root1;
X!		    }
X!		} /* for i */
X#define ibeg %i0
X#define iend %i1
X#define rsl  %i2
X#define logp %i3
X#define I4 %i4
X			/* I4 = 4*i */
X#define root2p %i5
X#define root2 %l0
X#define rootdif %l1
X		/* root2, rootdif must be even-odd pair for ldd and std */
X#define root1 %l2
X#define end_primbase %l3
X#define sieve_rsl %l4
X#define sieve1	%l5
X#define rootsi	%l6
X#define twicep  %l7
X#define temp1  %o0
X#define temp2  %o1
X#define temp3  %o2
X#define temp4  %o3
X#define p      %o4
X
X	.globl	lowp_siever		! lowp_siever(ibeg, iend, rsl, logp)
Xlowp_siever:
X	save	%sp,-WINDOWSIZE,%sp
X	subcc	ibeg,iend,I4			! ibeg - iend
X	bg	9f				! Exit if ibeg > iend
X	sll	I4,2,I4				! I4 = 4*(ibeg - iend) (delay)
X
X	set	primbase,end_primbase
X	set	roots,rootsi
X	set	sieve,sieve_rsl
X	ld	[end_primbase],end_primbase	! Load C pointer values
X	ld	[rootsi],rootsi
X	ld	[sieve_rsl],sieve_rsl
X	sll	iend,2,iend			! iend <- 4*iend
X	sll	ibeg,3,ibeg			! ibeg <- 8*ibeg
X	add	iend,end_primbase,end_primbase  ! &primbase[iend]
X	add	ibeg,rootsi,rootsi		! &roots[ibeg]	
X	ba	2f				! Enter outer loop
X	add	rsl,sieve_rsl,sieve_rsl		! &sieve[rsl] (delay)
X
X1:						! Come here if root1 >= 0
X	st	root1,[rootsi]			! roots[i].r1 = root1	
X	bg	9f				! Terminate if 4*i > 0
X	inc	8,rootsi			! Advance &roots[i] (delay)
X	
X2:						! Start of outer loop
X	ldd	[rootsi],root2			! root2 = roots[i].r1
X						! rootdif = roots[i].r2
X	ld	[end_primbase+I4],p		! p = end_primbase[i]
X#if ASSEM_TRAPS > 1
X	/* Expect 0 <= roots[i].r1 <= roots[i].r1 + roots[i].r2 < p <= rsl */
X	tst root2;	tl  0			! Is 0 <= roots[i].r1?
X	tst rootdif;	tl  0			! Is 0 <= roots[i].r2?
X	add root2,rootdif,temp1	
X	cmp temp1,p;    tge 0		! Is roots[i].r1 + roots[i].r2 < p?
X	cmp p,rsl;	tg  0			! Is p <= rsl?
X#endif
X	sub	root2,rsl,root2			! root2 = roots[i].r1 - rsl
X	add	root2,rootdif,root2		!		      + rootdif
X	sub	sieve_rsl,rootdif,sieve1	! sieve1 = sieve_rsl - rootdif
X	add	root2,p,root2p			! root2p = root2 + p	
X	add	p,p,twicep			! 2*p
X
X3:						! Inner loop
X	ldub	[sieve1+root2],temp1;	ldub [sieve_rsl+root2],temp2
X	ldub	[sieve1+root2p],temp3;	ldub [sieve_rsl+root2p],temp4
X	add	temp1,logp,temp1;	add temp2,logp,temp2
X	stb	temp1,[sieve1+root2];	stb temp2,[sieve_rsl+root2]
X	add	temp3,logp,temp3;	add temp4,logp,temp4
X	stb	temp3,[sieve1+root2p];	stb temp4,[sieve_rsl+root2p]
X					! Add logp to each value
X	addcc	twicep,root2p,root2p		! root2p += 2*p
X	blt	3b;				! Loop while root2p < 0
X	addcc	twicep,root2,root2		! root2 += 2*p (delay)
X
X	bge,a	4f				! Branch if root2 >= 0
X	subcc	root2,rootdif,root1		! root1 = smaller root (delay)
X
X	ldub	[sieve1+root2],temp1;	ldub [sieve_rsl+root2],temp2
X	add	temp1,logp,temp1;	add temp2,logp,temp2
X	stb	temp1,[sieve1+root2];	stb temp2,[sieve_rsl+root2]
X	subcc	root2p,rootdif,root1		! root1 = smaller root
X	add	p,root2,root2
X4:
X	bge	1b				! Branch if root1 >= 0
X	inccc	4,I4				! Increment 4*i (delay)
X
X	ldub	[sieve_rsl+root1],temp1
X	sub	p,rootdif,rootdif		! p - rootdif
X	std	root2,[rootsi]			! roots[i].r1 = root2
X						! roots[i].r2 = p - rootdif
X	add	temp1,logp,temp1; stb temp1,[sieve_rsl+root1]
X	ble	2b				! Continue if 4*i <= 0
X	inc	8,rootsi			! Advance @roots[i] (delay)
X
X9:
X	ret					! Exit
X	restore					! (delay)	
X
X#undef ibeg
X#undef iend
X#undef rsl
X#undef I4
X#undef logp
X#undef root2p
X#undef root1
X#undef end_primbase
X#undef sieve_rsl
X#undef sieve1
X#undef rootsi
X#undef twicep
X#undef temp1
X#undef temp2
X#undef temp3
X#undef temp4
X#undef p
X!
X!		medp_siever(ibeg, iend, rsl, logp)
X!
X!		rootsi = &roots[ibeg];
X!		end_primbase = &primbase[iend];
X!		sieve_rsl = sieve + rsl
X!		for (i = ibeg-iend; i <= 0;  i++, rootsi++) {
X!		    p = end_primbase[i];
X!		    rootdif = rootsi->r2;
X!		    root1 = rootsi->r1 - rsl;
X!		    root2 = root1 + rootdif;
X!		    sieve_rsl[root1] += logp;
X!		    sieve_rsl[root2] += logp;
X!		    root1 += p;
X!		    if (root1 < 0) {
X!			sieve_rsl[root1] += logp;
X!			root2 += p;
X!			if (root2 < 0) {
X!			    sieve_rsl[root2] += logp;
X!			    rootsi->r1 = root1 + p;
X!			} else {
X!			    rootsi->r1 = root2;
X!			    roots[i].r2 = p - rootdif;
X!			}
X!		    } else {
X!			rootsi->r1 = root1;
X!		    }
X!		} /* for i */
X#define ibeg %i0
X#define iend %i1
X#define rsl  %i2
X#define logp %i3
X#define I4 %i4
X			/* I4 = 4*i */
X#define root2 %l0
X#define rootdif %l1
X		/* root2, rootdif must be even-odd pair for ldd and std */
X#define root1 %l2
X#define end_primbase %l3
X#define sieve_rsl %l4
X#define rootsi	%l6
X#define temp1  %o0
X#define temp2  %o1
X#define temp3  %o2
X#define temp4  %o3
X#define p      %o4
X
X	.globl	medp_siever		! medp_siever(ibeg, iend, rsl, logp)
Xmedp_siever:
X	save	%sp,-WINDOWSIZE,%sp
X	subcc	ibeg,iend,I4			! ibeg - iend
X	bg	9f				! Exit if ibeg > iend
X	sll	I4,2,I4				! I4 = 4*(ibeg - iend) (delay)
X
X	set	primbase,end_primbase
X	set	roots,rootsi
X	set	sieve,sieve_rsl
X	ld	[end_primbase],end_primbase	! Load C pointer values
X	ld	[rootsi],rootsi
X	ld	[sieve_rsl],sieve_rsl
X	sll	iend,2,iend			! iend <- 4*iend
X	sll	ibeg,3,ibeg			! ibeg <- 8*ibeg
X	add	iend,end_primbase,end_primbase  ! &primbase[iend]
X	add	ibeg,rootsi,rootsi		! &roots[ibeg]	
X	ba	2f				! Enter outer loop
X	add	rsl,sieve_rsl,sieve_rsl		! &sieve[rsl] (delay)
X
X8:						! Come here if root2 < 0
X	ldub	[sieve_rsl+root2],temp2
X	stb	temp1,[sieve_rsl+root1]		! Update sieve_rsl[root1]
X	add	root1,p,root1			! root1 += p
X	add	temp2,logp,temp2
X	stb	temp2,[sieve_rsl+root2]		! Update sieve_rsl[root2]
X
X1:						! Come here if root1 >= 0
X	inccc	4,I4				! Increment 4*i
X	st	root1,[rootsi]			! roots[i].r1 = root1	
X	bg	9f				! Terminate if 4*i > 0
X	inc	8,rootsi			! Advance &roots[i] (delay)
X	
X2:						! Start of outer loop
X	ldd	[rootsi],root2			! root2 = roots[i].r1
X						! rootdif = roots[i].r2
X	ld	[end_primbase+I4],p		! p = end_primbase[i]
X#if ASSEM_TRAPS > 1
X	/* Expect 0 <= roots[i].r1 <= roots[i].r1 + roots[i].r2 < p <= rsl */
X	tst root2;	tl  0			! Is 0 <= roots[i].r1?
X	tst rootdif;	tl  0			! Is 0 <= roots[i].r2?
X	add root2,rootdif,temp1	
X	cmp temp1,p;    tge 0		! Is roots[i].r1 + roots[i].r2 < p?
X	cmp p,rsl;	tg  0			! Is p >= rsl?
X#endif
X	sub	root2,rsl,root1			! root1 = roots[i].r1 - rsl
X	ldub	[sieve_rsl+root1],temp1
X	add	root1,rootdif,root2		! root2 = root1 + rootdif
X	ldub	[sieve_rsl+root2],temp2
X	add	temp1,logp,temp1;
X	stb	temp1,[sieve_rsl+root1]		! Update sieve_rsl[root1]
X	addcc	root1,p,root1			! root1 += p
X	add	temp2,logp,temp2
X	bge	1b				! Branch if root1 >= 0
X	stb	temp2,[sieve_rsl+root2]	! Update sieve_rsl[root2] (delay)
X
X	ldub	[sieve_rsl+root1],temp1
X	addcc	root2,p,root2			! root2 += p
X	bl	8b				! Branch if root2 >= 0
X	add	temp1,logp,temp1		! (delay)
X
X	sub	p,rootdif,rootdif		! p - rootdif
X	stb	temp1,[sieve_rsl+root1]		! Update sieve_rsl[root1]
X	inccc	4,I4				! Increment 4*i
X	std	root2,[rootsi]			! roots[i].r1 = root2
X						! roots[i].r2 = p - rootdif
X	ble	2b				! Continue if 4*i <= 0
X	inc	8,rootsi			! Advance @roots[i] (delay)
X
X9:
X	ret					! Exit
X	restore					! (delay)	
X
X#undef ibeg
X#undef iend
X#undef rsl
X#undef I4
X#undef logp
X#undef root1
X#undef end_primbase
X#undef sieve_rsl
X#undef rootsi
X#undef temp1
X#undef temp2
X#undef temp3
X#undef temp4
X#undef p
X!
X!
X!		first_ge(array, start, bound)	(leaf)
X!		(see C code)
X#define array %o0
X#define start %o1
X#define bound %o2
X#define parray %o3
X#define x80808080 %o4
X#define lbound %g1
X#define test1  %g2
X#define test2  %g3
X#define test3  %g4
X#define test4  %g5
X		/* test1-test4 must be two even-odd pairs */
X
X	.globl	first_ge
Xfirst_ge:				! first_ge(array, start, bound)
X	and	bound,255,bound
X	sub	bound,1,lbound		! bound-1
X	sll	lbound,8,test1
X	or	test1,lbound,lbound	! 257*(bound-1)
X	sll	lbound,16,test2
X	or	test2,lbound,lbound	! lbound = 65537*257*(bound - 1)
X					!	 = 0x01010101 * (bound-1)
X	add	array,start,parray
X	set	0x80808080,x80808080
X1:
X	andcc	parray,15,test1
X	be	3f			! Branch if multiple of 16
X	.empty
X
X2:					! Byte search mode
X	ldub	[parray],test1
X	cmp	test1,bound
X	blt,a	1b			! Branch if value too small
X	inc	parray			! Increment address (delay)
X
X	retl
X	sub	parray,array,%o0  ! Function value = parray - array (delay)
X
X3:
X	ldd	[parray],test1		! Load test1-test4
X	ldd	[parray+8],test3	
X	sub	lbound,test1,test1
X	sub	lbound,test2,test2
X	sub	lbound,test3,test3
X	sub	lbound,test4,test4
X	or	test2,test1,test1
X	or	test4,test3,test3
X	or	test3,test1,test1
X	andcc	test1,x80808080,test1
X	be,a	3b			! Branch if nothing good found
X	inc	16,parray		! and increment address (delay)
X	
X	ba,a	2b			! Return to byte mode
X
X#undef array
X#undef start
X#undef bound
X#undef parray
X#undef x80808080
X#undef lbound
X#undef test1
X#undef test2
X#undef test3
X#undef test4
X
X!
X!
X!		sieveinit(lng, value)			(leaf)
X#define lng %o0
X#define value %o1
X#define dvalue1 %o2
X#define dvalue2 %o3
X	/* dvalue1 - dvalue2 must be even-odd pair */
X#define nxtadd	%o4
X
X	.globl	sieveinit
Xsieveinit:				! sieveinit(lng, value)
X	mov	value,dvalue1
X	mov	value,dvalue2
X	subcc	lng,128,lng		! Decrement by 128 bytes
X	set	sieve,nxtadd
X	bl	2f			! If fewer than 128 to do
X	ld	[nxtadd],nxtadd		! nxtadd = sieve (delay)
X1:
X	std	dvalue1,[nxtadd+  0];	std	dvalue1,[nxtadd+  8]
X	std	dvalue1,[nxtadd+ 16];	std	dvalue1,[nxtadd+ 24]
X	std	dvalue1,[nxtadd+ 32];	std	dvalue1,[nxtadd+ 40]
X	std	dvalue1,[nxtadd+ 48];	std	dvalue1,[nxtadd+ 56]
X	subcc	lng,128,lng
X	std	dvalue1,[nxtadd+ 64];	std	dvalue1,[nxtadd+ 72]
X	std	dvalue1,[nxtadd+ 80];	std	dvalue1,[nxtadd+ 88]
X	std	dvalue1,[nxtadd+ 96];	std	dvalue1,[nxtadd+104]
X	std	dvalue1,[nxtadd+112];	std	dvalue1,[nxtadd+120]
X	bge	1b			! if at least 128 to go
X	add	nxtadd,128,nxtadd	! (delay)
X2:	
X	addcc	lng,128,lng		! Restore remaining byte count
X	ble	4f			! Exit if nothing to clear
X	.empty
X
X3:					! Finish eight bytes at a time
X	subcc	lng,8,lng
X	std	dvalue1,[nxtadd]
X	bg	3b			! If more bytes to go
X	add	nxtadd,8,nxtadd		! (delay)
X4:
X	retl				! Return from leaf
X	nop
X#undef lng
X#undef value
X#undef dvalue1
X#undef dvalue2
X#undef nxtadd
X
END_OF_FILE
if test 14636 -ne `wc -c <'src/sparc-solaris.s'`; then
    echo shar: \"'src/sparc-solaris.s'\" unpacked with wrong size!
fi
# end of 'src/sparc-solaris.s'
fi
if test -f 'src/sparc-sunos.s' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'src/sparc-sunos.s'\"
else
echo shar: Extracting \"'src/sparc-sunos.s'\" \(14657 characters\)
sed "s/^X//" >'src/sparc-sunos.s' <<'END_OF_FILE'
X#define NBITS 30	
X!	Assembly versions of selected  routines
X!
X!			bigp_siever	(mpqs.c)
X!			first_ge	(mpqs.c)
X!			lowp_siever	(mpqs.c)
X!			medp_siever	(mpqs.c)
X!			sieveinit	(mpqs.c)
X!
X!	Use -DCONTRIBUTION_8 when compiling mpqs.c.
X!
X!	If this file is named "foo.s", then assemble with
X!	"as -P -DFPU foo.s -o foo.o" if you have a floating-point
X!	coprocessor, and with "as -P foo.s foo.o" if you do not.
X!
X!	Contributed by
X!
X!			Peter L. Montgomery
X!			Department of Mathematics
X!			University of California
X!			Los Angeles, CA 90024
X!		
X!			pmontgom@math.ucla.edu
X!			June, 1990
X!^L
X#include <sun4/asm_linkage.h>
X#define ASSEM_TRAPS 1
X		! ASSEM_TRAPS = 0 to omit execution-time checks
X		! ASSEM_TRAPS = 1 to minimal checking
X		! ASSEM_TRAPS = 2 for extensive checking
X
X!
X!		bigp_siever(ibeg, iend, rsl, logp)
X!
X!		rootsi = &roots[ibeg];
X!		end_primbase = &primbase[iend];
X!		sieve_rsl = sieve + rsl
X!		for (i = ibeg-iend; i <= 0;  i++, rootsi++) {
X!		    rootdif = rootsi->r2;
X!		    root1 = rootsi->r1 - rsl;
X!		    if (root1 < 0) {
X!			p = end_primbase[i];
X!			sieve_rsl[root1] += logp;
X!			root2 = root1 + rootdif
X!			if (root2 < 0) {
X!			    sieve_rsl[root2] += logp;
X!			    rootsi->r1 = root1 + p;
X!			} else {
X!			    rootsi->r1 = root2;
X!			    roots[i].r2 = p - rootdif;
X!			}
X!		    } else {
X!			rootsi->r1 = root1;
X!		    }
X!		} /* for i */
X#define ibeg %i0
X#define iend %i1
X#define rsl  %i2
X#define logp %i3
X#define I4 %i4
X			/* I4 = 4*i */
X#define root2 %l0
X#define rootdif %l1
X		/* root2, rootdif must be even-odd pair for ldd and std */
X#define root1 %l2
X#define end_primbase %l3
X#define sieve_rsl %l4
X#define rootsi	%l6
X#define temp1  %o0
X#define temp2  %o1
X#define temp3  %o2
X#define temp4  %o3
X#define p      %o4
X
X	.globl	_bigp_siever		! bigp_siever(ibeg, iend, rsl, logp)
X_bigp_siever:
X	save	%sp,-WINDOWSIZE,%sp
X	subcc	ibeg,iend,I4			! ibeg - iend
X	bg	9f				! Exit if ibeg > iend
X	sll	I4,2,I4				! I4 = 4*(ibeg - iend) (delay)
X
X	set	_primbase,end_primbase
X	set	_roots,rootsi
X	set	_sieve,sieve_rsl
X	ld	[end_primbase],end_primbase	! Load C pointer values
X	ld	[rootsi],rootsi
X	ld	[sieve_rsl],sieve_rsl
X	sll	iend,2,iend			! iend <- 4*iend
X	sll	ibeg,3,ibeg			! ibeg <- 8*ibeg
X	add	iend,end_primbase,end_primbase  ! &primbase[iend]
X	add	ibeg,rootsi,rootsi		! &roots[ibeg]	
X	ba	2f				! Enter outer loop
X	add	rsl,sieve_rsl,sieve_rsl		! &sieve[rsl] (delay)
X
X8:						! Come here if root2 < 0
X	ldub	[sieve_rsl+root2],temp2
X	stb	temp1,[sieve_rsl+root1]		! Update sieve_rsl[root1]
X	add	root1,p,root1			! root1 += p
X	add	temp2,logp,temp2
X	stb	temp2,[sieve_rsl+root2]		! Update sieve_rsl[root2]
X
X1:						! Come here if root1 >= 0
X	inccc	4,I4				! Increment 4*i
X	st	root1,[rootsi]			! roots[i].r1 = root1	
X	bg	9f				! Terminate if 4*i > 0
X	inc	8,rootsi			! Advance &roots[i] (delay)
X	
X2:						! Start of outer loop
X	ldd	[rootsi],root2			! root2 = roots[i].r1
X						! rootdif = roots[i].r2
X#if ASSEM_TRAPS > 1
X	/* Expect 0 <= roots[i].r1 <= roots[i].r1 + roots[i].r2 < p >= rsl */
X	tst root2;	tl  0			! Is 0 <= roots[i].r1?
X	tst rootdif;	tl  0			! Is 0 <= roots[i].r2?
X	ld	[end_primbase+I4],p		! p = end_primbase[i]
X	add root2,rootdif,temp1	
X	cmp temp1,p;    tge 0		! Is roots[i].r1 + roots[i].r2 < p?
X	cmp p,rsl;	tl  0			! Is p <= rsl?
X#endif
X	subcc	root2,rsl,root1			! root1 = roots[i].r1 - rsl
X	bge	1b				! Branch if root1 >= 0
X	addcc	root1,rootdif,root2	   ! root2 = root1 + rootdif (delay)
X
X	ldub	[sieve_rsl+root1],temp1
X	ld	[end_primbase+I4],p		! p = end_primbase[i]
X	bl	8b				! Branch if root2 >= 0
X	add	temp1,logp,temp1		! (delay)
X
X	sub	p,rootdif,rootdif		! p - rootdif
X	stb	temp1,[sieve_rsl+root1]		! Update sieve_rsl[root1]
X	inccc	4,I4				! Increment 4*i
X	std	root2,[rootsi]			! roots[i].r1 = root2
X						! roots[i].r2 = p - rootdif
X	ble	2b				! Continue if 4*i <= 0
X	inc	8,rootsi			! Advance @roots[i] (delay)
X
X9:
X	ret					! Exit
X	restore					! (delay)	
X
X#undef ibeg
X#undef iend
X#undef rsl
X#undef I4
X#undef logp
X#undef root1
X#undef end_primbase
X#undef sieve_rsl
X#undef rootsi
X#undef temp1
X#undef temp2
X#undef temp3
X#undef temp4
X#undef p
X!
X!		lowp_siever(ibeg, iend, rsl, logp)
X!
X!		rootsi = &roots[ibeg];
X!		end_primbase = &primbase[iend];
X!		sieve_rsl = sieve + rsl
X!		for (i = ibeg-iend; i <= 0;  i++, rootsi++) {
X!		    p = end_primbase[i];
X!		    rootdif = rootsi->r2;
X!		    root2 = rootsi->r1 - rsl + rootdif;
X!		    sieve1 = sieve_rsl - rootdif;
X!		    root2p = root2 + p
X!		    do {
X!			sieve1   [root2 ] += logp;
X!			sieve_rsl[root2 ] += logp;
X!			sieve1   [root2p] += logp;
X!			sieve_rsl[root2p] += logp;
X!			root2  += 2*p;
X!			root2p += 2*p
X!		    } while (root2p < 0);
X!		    if (root2 < 0) {
X!			sieve1   [root2] += logp;
X!			sieve_rsl[root2] += logp;
X!			root2 += p;
X!		    }
X!		    root1 = root2 - rootdif;
X!		    if (root1 < 0) {
X!			sieve_rsl[root1] += logp;
X!			rootsi->r1 = root2;		/* Smaller new root */
X!			rootsi->r2 = p - rootdif;	/* New difference */
X!		    } else {
X!			rootsi->r1 = root1;
X!		    }
X!		} /* for i */
X#define ibeg %i0
X#define iend %i1
X#define rsl  %i2
X#define logp %i3
X#define I4 %i4
X			/* I4 = 4*i */
X#define root2p %i5
X#define root2 %l0
X#define rootdif %l1
X		/* root2, rootdif must be even-odd pair for ldd and std */
X#define root1 %l2
X#define end_primbase %l3
X#define sieve_rsl %l4
X#define sieve1	%l5
X#define rootsi	%l6
X#define twicep  %l7
X#define temp1  %o0
X#define temp2  %o1
X#define temp3  %o2
X#define temp4  %o3
X#define p      %o4
X
X	.globl	_lowp_siever		! lowp_siever(ibeg, iend, rsl, logp)
X_lowp_siever:
X	save	%sp,-WINDOWSIZE,%sp
X	subcc	ibeg,iend,I4			! ibeg - iend
X	bg	9f				! Exit if ibeg > iend
X	sll	I4,2,I4				! I4 = 4*(ibeg - iend) (delay)
X
X	set	_primbase,end_primbase
X	set	_roots,rootsi
X	set	_sieve,sieve_rsl
X	ld	[end_primbase],end_primbase	! Load C pointer values
X	ld	[rootsi],rootsi
X	ld	[sieve_rsl],sieve_rsl
X	sll	iend,2,iend			! iend <- 4*iend
X	sll	ibeg,3,ibeg			! ibeg <- 8*ibeg
X	add	iend,end_primbase,end_primbase  ! &primbase[iend]
X	add	ibeg,rootsi,rootsi		! &roots[ibeg]	
X	ba	2f				! Enter outer loop
X	add	rsl,sieve_rsl,sieve_rsl		! &sieve[rsl] (delay)
X
X1:						! Come here if root1 >= 0
X	st	root1,[rootsi]			! roots[i].r1 = root1	
X	bg	9f				! Terminate if 4*i > 0
X	inc	8,rootsi			! Advance &roots[i] (delay)
X	
X2:						! Start of outer loop
X	ldd	[rootsi],root2			! root2 = roots[i].r1
X						! rootdif = roots[i].r2
X	ld	[end_primbase+I4],p		! p = end_primbase[i]
X#if ASSEM_TRAPS > 1
X	/* Expect 0 <= roots[i].r1 <= roots[i].r1 + roots[i].r2 < p <= rsl */
X	tst root2;	tl  0			! Is 0 <= roots[i].r1?
X	tst rootdif;	tl  0			! Is 0 <= roots[i].r2?
X	add root2,rootdif,temp1	
X	cmp temp1,p;    tge 0		! Is roots[i].r1 + roots[i].r2 < p?
X	cmp p,rsl;	tg  0			! Is p <= rsl?
X#endif
X	sub	root2,rsl,root2			! root2 = roots[i].r1 - rsl
X	add	root2,rootdif,root2		!		      + rootdif
X	sub	sieve_rsl,rootdif,sieve1	! sieve1 = sieve_rsl - rootdif
X	add	root2,p,root2p			! root2p = root2 + p	
X	add	p,p,twicep			! 2*p
X
X3:						! Inner loop
X	ldub	[sieve1+root2],temp1;	ldub [sieve_rsl+root2],temp2
X	ldub	[sieve1+root2p],temp3;	ldub [sieve_rsl+root2p],temp4
X	add	temp1,logp,temp1;	add temp2,logp,temp2
X	stb	temp1,[sieve1+root2];	stb temp2,[sieve_rsl+root2]
X	add	temp3,logp,temp3;	add temp4,logp,temp4
X	stb	temp3,[sieve1+root2p];	stb temp4,[sieve_rsl+root2p]
X					! Add logp to each value
X	addcc	twicep,root2p,root2p		! root2p += 2*p
X	blt	3b;				! Loop while root2p < 0
X	addcc	twicep,root2,root2		! root2 += 2*p (delay)
X
X	bge,a	4f				! Branch if root2 >= 0
X	subcc	root2,rootdif,root1		! root1 = smaller root (delay)
X
X	ldub	[sieve1+root2],temp1;	ldub [sieve_rsl+root2],temp2
X	add	temp1,logp,temp1;	add temp2,logp,temp2
X	stb	temp1,[sieve1+root2];	stb temp2,[sieve_rsl+root2]
X	subcc	root2p,rootdif,root1		! root1 = smaller root
X	add	p,root2,root2
X4:
X	bge	1b				! Branch if root1 >= 0
X	inccc	4,I4				! Increment 4*i (delay)
X
X	ldub	[sieve_rsl+root1],temp1
X	sub	p,rootdif,rootdif		! p - rootdif
X	std	root2,[rootsi]			! roots[i].r1 = root2
X						! roots[i].r2 = p - rootdif
X	add	temp1,logp,temp1; stb temp1,[sieve_rsl+root1]
X	ble	2b				! Continue if 4*i <= 0
X	inc	8,rootsi			! Advance @roots[i] (delay)
X
X9:
X	ret					! Exit
X	restore					! (delay)	
X
X#undef ibeg
X#undef iend
X#undef rsl
X#undef I4
X#undef logp
X#undef root2p
X#undef root1
X#undef end_primbase
X#undef sieve_rsl
X#undef sieve1
X#undef rootsi
X#undef twicep
X#undef temp1
X#undef temp2
X#undef temp3
X#undef temp4
X#undef p
X!
X!		medp_siever(ibeg, iend, rsl, logp)
X!
X!		rootsi = &roots[ibeg];
X!		end_primbase = &primbase[iend];
X!		sieve_rsl = sieve + rsl
X!		for (i = ibeg-iend; i <= 0;  i++, rootsi++) {
X!		    p = end_primbase[i];
X!		    rootdif = rootsi->r2;
X!		    root1 = rootsi->r1 - rsl;
X!		    root2 = root1 + rootdif;
X!		    sieve_rsl[root1] += logp;
X!		    sieve_rsl[root2] += logp;
X!		    root1 += p;
X!		    if (root1 < 0) {
X!			sieve_rsl[root1] += logp;
X!			root2 += p;
X!			if (root2 < 0) {
X!			    sieve_rsl[root2] += logp;
X!			    rootsi->r1 = root1 + p;
X!			} else {
X!			    rootsi->r1 = root2;
X!			    roots[i].r2 = p - rootdif;
X!			}
X!		    } else {
X!			rootsi->r1 = root1;
X!		    }
X!		} /* for i */
X#define ibeg %i0
X#define iend %i1
X#define rsl  %i2
X#define logp %i3
X#define I4 %i4
X			/* I4 = 4*i */
X#define root2 %l0
X#define rootdif %l1
X		/* root2, rootdif must be even-odd pair for ldd and std */
X#define root1 %l2
X#define end_primbase %l3
X#define sieve_rsl %l4
X#define rootsi	%l6
X#define temp1  %o0
X#define temp2  %o1
X#define temp3  %o2
X#define temp4  %o3
X#define p      %o4
X
X	.globl	_medp_siever		! medp_siever(ibeg, iend, rsl, logp)
X_medp_siever:
X	save	%sp,-WINDOWSIZE,%sp
X	subcc	ibeg,iend,I4			! ibeg - iend
X	bg	9f				! Exit if ibeg > iend
X	sll	I4,2,I4				! I4 = 4*(ibeg - iend) (delay)
X
X	set	_primbase,end_primbase
X	set	_roots,rootsi
X	set	_sieve,sieve_rsl
X	ld	[end_primbase],end_primbase	! Load C pointer values
X	ld	[rootsi],rootsi
X	ld	[sieve_rsl],sieve_rsl
X	sll	iend,2,iend			! iend <- 4*iend
X	sll	ibeg,3,ibeg			! ibeg <- 8*ibeg
X	add	iend,end_primbase,end_primbase  ! &primbase[iend]
X	add	ibeg,rootsi,rootsi		! &roots[ibeg]	
X	ba	2f				! Enter outer loop
X	add	rsl,sieve_rsl,sieve_rsl		! &sieve[rsl] (delay)
X
X8:						! Come here if root2 < 0
X	ldub	[sieve_rsl+root2],temp2
X	stb	temp1,[sieve_rsl+root1]		! Update sieve_rsl[root1]
X	add	root1,p,root1			! root1 += p
X	add	temp2,logp,temp2
X	stb	temp2,[sieve_rsl+root2]		! Update sieve_rsl[root2]
X
X1:						! Come here if root1 >= 0
X	inccc	4,I4				! Increment 4*i
X	st	root1,[rootsi]			! roots[i].r1 = root1	
X	bg	9f				! Terminate if 4*i > 0
X	inc	8,rootsi			! Advance &roots[i] (delay)
X	
X2:						! Start of outer loop
X	ldd	[rootsi],root2			! root2 = roots[i].r1
X						! rootdif = roots[i].r2
X	ld	[end_primbase+I4],p		! p = end_primbase[i]
X#if ASSEM_TRAPS > 1
X	/* Expect 0 <= roots[i].r1 <= roots[i].r1 + roots[i].r2 < p <= rsl */
X	tst root2;	tl  0			! Is 0 <= roots[i].r1?
X	tst rootdif;	tl  0			! Is 0 <= roots[i].r2?
X	add root2,rootdif,temp1	
X	cmp temp1,p;    tge 0		! Is roots[i].r1 + roots[i].r2 < p?
X	cmp p,rsl;	tg  0			! Is p >= rsl?
X#endif
X	sub	root2,rsl,root1			! root1 = roots[i].r1 - rsl
X	ldub	[sieve_rsl+root1],temp1
X	add	root1,rootdif,root2		! root2 = root1 + rootdif
X	ldub	[sieve_rsl+root2],temp2
X	add	temp1,logp,temp1;
X	stb	temp1,[sieve_rsl+root1]		! Update sieve_rsl[root1]
X	addcc	root1,p,root1			! root1 += p
X	add	temp2,logp,temp2
X	bge	1b				! Branch if root1 >= 0
X	stb	temp2,[sieve_rsl+root2]	! Update sieve_rsl[root2] (delay)
X
X	ldub	[sieve_rsl+root1],temp1
X	addcc	root2,p,root2			! root2 += p
X	bl	8b				! Branch if root2 >= 0
X	add	temp1,logp,temp1		! (delay)
X
X	sub	p,rootdif,rootdif		! p - rootdif
X	stb	temp1,[sieve_rsl+root1]		! Update sieve_rsl[root1]
X	inccc	4,I4				! Increment 4*i
X	std	root2,[rootsi]			! roots[i].r1 = root2
X						! roots[i].r2 = p - rootdif
X	ble	2b				! Continue if 4*i <= 0
X	inc	8,rootsi			! Advance @roots[i] (delay)
X
X9:
X	ret					! Exit
X	restore					! (delay)	
X
X#undef ibeg
X#undef iend
X#undef rsl
X#undef I4
X#undef logp
X#undef root1
X#undef end_primbase
X#undef sieve_rsl
X#undef rootsi
X#undef temp1
X#undef temp2
X#undef temp3
X#undef temp4
X#undef p
X!
X!
X!		first_ge(array, start, bound)	(leaf)
X!		(see C code)
X#define array %o0
X#define start %o1
X#define bound %o2
X#define parray %o3
X#define x80808080 %o4
X#define lbound %g1
X#define test1  %g2
X#define test2  %g3
X#define test3  %g4
X#define test4  %g5
X		/* test1-test4 must be two even-odd pairs */
X
X	.globl	_first_ge
X_first_ge:				! first_ge(array, start, bound)
X	and	bound,255,bound
X	sub	bound,1,lbound		! bound-1
X	sll	lbound,8,test1
X	or	test1,lbound,lbound	! 257*(bound-1)
X	sll	lbound,16,test2
X	or	test2,lbound,lbound	! lbound = 65537*257*(bound - 1)
X					!	 = 0x01010101 * (bound-1)
X	add	array,start,parray
X	set	0x80808080,x80808080
X1:
X	andcc	parray,15,test1
X	be	3f			! Branch if multiple of 16
X	.empty
X
X2:					! Byte search mode
X	ldub	[parray],test1
X	cmp	test1,bound
X	blt,a	1b			! Branch if value too small
X	inc	parray			! Increment address (delay)
X
X	retl
X	sub	parray,array,%o0  ! Function value = parray - array (delay)
X
X3:
X	ldd	[parray],test1		! Load test1-test4
X	ldd	[parray+8],test3	
X	sub	lbound,test1,test1
X	sub	lbound,test2,test2
X	sub	lbound,test3,test3
X	sub	lbound,test4,test4
X	or	test2,test1,test1
X	or	test4,test3,test3
X	or	test3,test1,test1
X	andcc	test1,x80808080,test1
X	be,a	3b			! Branch if nothing good found
X	inc	16,parray		! and increment address (delay)
X	
X	ba,a	2b			! Return to byte mode
X
X#undef array
X#undef start
X#undef bound
X#undef parray
X#undef x80808080
X#undef lbound
X#undef test1
X#undef test2
X#undef test3
X#undef test4
X
X!
X!
X!		sieveinit(lng, value)			(leaf)
X#define lng %o0
X#define value %o1
X#define dvalue1 %o2
X#define dvalue2 %o3
X	/* dvalue1 - dvalue2 must be even-odd pair */
X#define nxtadd	%o4
X
X	.globl	_sieveinit
X_sieveinit:				! sieveinit(lng, value)
X	mov	value,dvalue1
X	mov	value,dvalue2
X	subcc	lng,128,lng		! Decrement by 128 bytes
X	set	_sieve,nxtadd
X	bl	2f			! If fewer than 128 to do
X	ld	[nxtadd],nxtadd		! nxtadd = sieve (delay)
X1:
X	std	dvalue1,[nxtadd+  0];	std	dvalue1,[nxtadd+  8]
X	std	dvalue1,[nxtadd+ 16];	std	dvalue1,[nxtadd+ 24]
X	std	dvalue1,[nxtadd+ 32];	std	dvalue1,[nxtadd+ 40]
X	std	dvalue1,[nxtadd+ 48];	std	dvalue1,[nxtadd+ 56]
X	subcc	lng,128,lng
X	std	dvalue1,[nxtadd+ 64];	std	dvalue1,[nxtadd+ 72]
X	std	dvalue1,[nxtadd+ 80];	std	dvalue1,[nxtadd+ 88]
X	std	dvalue1,[nxtadd+ 96];	std	dvalue1,[nxtadd+104]
X	std	dvalue1,[nxtadd+112];	std	dvalue1,[nxtadd+120]
X	bge	1b			! if at least 128 to go
X	add	nxtadd,128,nxtadd	! (delay)
X2:	
X	addcc	lng,128,lng		! Restore remaining byte count
X	ble	4f			! Exit if nothing to clear
X	.empty
X
X3:					! Finish eight bytes at a time
X	subcc	lng,8,lng
X	std	dvalue1,[nxtadd]
X	bg	3b			! If more bytes to go
X	add	nxtadd,8,nxtadd		! (delay)
X4:
X	retl				! Return from leaf
X	nop
X#undef lng
X#undef value
X#undef dvalue1
X#undef dvalue2
X#undef nxtadd
X
END_OF_FILE
if test 14657 -ne `wc -c <'src/sparc-sunos.s'`; then
    echo shar: \"'src/sparc-sunos.s'\" unpacked with wrong size!
fi
# end of 'src/sparc-sunos.s'
fi
echo shar: End of shell archive.
exit 0
