-
Notifications
You must be signed in to change notification settings - Fork 0
/
libf77
5169 lines (5169 loc) · 109 KB
/
libf77
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
# to unbundle, sh this file (in an empty directory)
mkdir libF77
echo libF77/uninit.c 1>&2
sed >libF77/uninit.c <<'//GO.SYSIN DD libF77/uninit.c' 's/^-//'
-#include <stdio.h>
-#include <string.h>
-#include "arith.h"
-
-#define TYSHORT 2
-#define TYLONG 3
-#define TYREAL 4
-#define TYDREAL 5
-#define TYCOMPLEX 6
-#define TYDCOMPLEX 7
-#define TYINT1 11
-#define TYQUAD 14
-#ifndef Long
-#define Long long
-#endif
-
-#ifdef __mips
-#define RNAN 0xffc00000
-#define DNAN0 0xfff80000
-#define DNAN1 0
-#endif
-
-#ifdef _PA_RISC1_1
-#define RNAN 0xffc00000
-#define DNAN0 0xfff80000
-#define DNAN1 0
-#endif
-
-#ifndef RNAN
-#define RNAN 0xff800001
-#ifdef IEEE_MC68k
-#define DNAN0 0xfff00000
-#define DNAN1 1
-#else
-#define DNAN0 1
-#define DNAN1 0xfff00000
-#endif
-#endif /*RNAN*/
-
-#ifdef KR_headers
-#define Void /*void*/
-#define FA7UL (unsigned Long) 0xfa7a7a7aL
-#else
-#define Void void
-#define FA7UL 0xfa7a7a7aUL
-#endif
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-static void ieee0(Void);
-
-static unsigned Long rnan = RNAN,
- dnan0 = DNAN0,
- dnan1 = DNAN1;
-
-double _0 = 0.;
-
- void
-#ifdef KR_headers
-_uninit_f2c(x, type, len) void *x; int type; long len;
-#else
-_uninit_f2c(void *x, int type, long len)
-#endif
-{
- static int first = 1;
-
- unsigned Long *lx, *lxe;
-
- if (first) {
- first = 0;
- ieee0();
- }
- if (len == 1)
- switch(type) {
- case TYINT1:
- *(char*)x = 'Z';
- return;
- case TYSHORT:
- *(short*)x = 0xfa7a;
- break;
- case TYLONG:
- *(unsigned Long*)x = FA7UL;
- return;
- case TYQUAD:
- case TYCOMPLEX:
- case TYDCOMPLEX:
- break;
- case TYREAL:
- *(unsigned Long*)x = rnan;
- return;
- case TYDREAL:
- lx = (unsigned Long*)x;
- lx[0] = dnan0;
- lx[1] = dnan1;
- return;
- default:
- printf("Surprise type %d in _uninit_f2c\n", type);
- }
- switch(type) {
- case TYINT1:
- memset(x, 'Z', len);
- break;
- case TYSHORT:
- *(short*)x = 0xfa7a;
- break;
- case TYQUAD:
- len *= 2;
- /* no break */
- case TYLONG:
- lx = (unsigned Long*)x;
- lxe = lx + len;
- while(lx < lxe)
- *lx++ = FA7UL;
- break;
- case TYCOMPLEX:
- len *= 2;
- /* no break */
- case TYREAL:
- lx = (unsigned Long*)x;
- lxe = lx + len;
- while(lx < lxe)
- *lx++ = rnan;
- break;
- case TYDCOMPLEX:
- len *= 2;
- /* no break */
- case TYDREAL:
- lx = (unsigned Long*)x;
- for(lxe = lx + 2*len; lx < lxe; lx += 2) {
- lx[0] = dnan0;
- lx[1] = dnan1;
- }
- }
- }
-#ifdef __cplusplus
-}
-#endif
-
-#ifndef MSpc
-#ifdef MSDOS
-#define MSpc
-#else
-#ifdef _WIN32
-#define MSpc
-#endif
-#endif
-#endif
-
-#ifdef MSpc
-#define IEEE0_done
-#include "float.h"
-#include "signal.h"
-
- static void
-ieee0(Void)
-{
-#ifndef __alpha
- _control87(EM_DENORMAL | EM_UNDERFLOW | EM_INEXACT, MCW_EM);
-#endif
- /* With MS VC++, compiling and linking with -Zi will permit */
- /* clicking to invoke the MS C++ debugger, which will show */
- /* the point of error -- provided SIGFPE is SIG_DFL. */
- signal(SIGFPE, SIG_DFL);
- }
-#endif /* MSpc */
-
-#ifdef __mips /* must link with -lfpe */
-#define IEEE0_done
-/* code from Eric Grosse */
-#include <stdlib.h>
-#include <stdio.h>
-#include "/usr/include/sigfpe.h" /* full pathname for lcc -N */
-#include "/usr/include/sys/fpu.h"
-
- static void
-#ifdef KR_headers
-ieeeuserhand(exception, val) unsigned exception[5]; int val[2];
-#else
-ieeeuserhand(unsigned exception[5], int val[2])
-#endif
-{
- fflush(stdout);
- fprintf(stderr,"ieee0() aborting because of ");
- if(exception[0]==_OVERFL) fprintf(stderr,"overflow\n");
- else if(exception[0]==_UNDERFL) fprintf(stderr,"underflow\n");
- else if(exception[0]==_DIVZERO) fprintf(stderr,"divide by 0\n");
- else if(exception[0]==_INVALID) fprintf(stderr,"invalid operation\n");
- else fprintf(stderr,"\tunknown reason\n");
- fflush(stderr);
- abort();
-}
-
- static void
-#ifdef KR_headers
-ieeeuserhand2(j) unsigned int **j;
-#else
-ieeeuserhand2(unsigned int **j)
-#endif
-{
- fprintf(stderr,"ieee0() aborting because of confusion\n");
- abort();
-}
-
- static void
-ieee0(Void)
-{
- int i;
- for(i=1; i<=4; i++){
- sigfpe_[i].count = 1000;
- sigfpe_[i].trace = 1;
- sigfpe_[i].repls = _USER_DETERMINED;
- }
- sigfpe_[1].repls = _ZERO; /* underflow */
- handle_sigfpes( _ON,
- _EN_UNDERFL|_EN_OVERFL|_EN_DIVZERO|_EN_INVALID,
- ieeeuserhand,_ABORT_ON_ERROR,ieeeuserhand2);
- }
-#endif /* mips */
-
-#ifdef __linux__
-#define IEEE0_done
-#include "fpu_control.h"
-
-#ifdef __alpha__
-#ifndef USE_setfpucw
-#define __setfpucw(x) __fpu_control = (x)
-#endif
-#endif
-
-#ifndef _FPU_SETCW
-#undef Can_use__setfpucw
-#define Can_use__setfpucw
-#endif
-
- static void
-ieee0(Void)
-{
-#if (defined(__mc68000__) || defined(__mc68020__) || defined(mc68020) || defined (__mc68k__))
-/* Reported 20010705 by Alan Bain <[email protected]> */
-/* Note that IEEE 754 IOP (illegal operation) */
-/* = Signaling NAN (SNAN) + operation error (OPERR). */
-#ifdef Can_use__setfpucw /* Has __setfpucw gone missing from S.u.S.E. 6.3? */
- __setfpucw(_FPU_IEEE + _FPU_DOUBLE + _FPU_MASK_OPERR + _FPU_MASK_DZ + _FPU_MASK_SNAN+_FPU_MASK_OVFL);
-#else
- __fpu_control = _FPU_IEEE + _FPU_DOUBLE + _FPU_MASK_OPERR + _FPU_MASK_DZ + _FPU_MASK_SNAN+_FPU_MASK_OVFL;
- _FPU_SETCW(__fpu_control);
-#endif
-
-#elif (defined(__powerpc__)||defined(_ARCH_PPC)||defined(_ARCH_PWR)) /* !__mc68k__ */
-/* Reported 20011109 by Alan Bain <[email protected]> */
-
-#ifdef Can_use__setfpucw
-
-/* The following is NOT a mistake -- the author of the fpu_control.h
-for the PPC has erroneously defined IEEE mode to turn on exceptions
-other than Inexact! Start from default then and turn on only the ones
-which we want*/
-
- __setfpucw(_FPU_DEFAULT + _FPU_MASK_IM+_FPU_MASK_OM+_FPU_MASK_UM);
-
-#else /* PPC && !Can_use__setfpucw */
-
- __fpu_control = _FPU_DEFAULT +_FPU_MASK_OM+_FPU_MASK_IM+_FPU_MASK_UM;
- _FPU_SETCW(__fpu_control);
-
-#endif /*Can_use__setfpucw*/
-
-#else /* !(mc68000||powerpc) */
-
-#ifdef _FPU_IEEE
-#ifndef _FPU_EXTENDED /* e.g., ARM processor under Linux */
-#define _FPU_EXTENDED 0
-#endif
-#ifndef _FPU_DOUBLE
-#define _FPU_DOUBLE 0
-#endif
-#ifdef Can_use__setfpucw /* Has __setfpucw gone missing from S.u.S.E. 6.3? */
- __setfpucw(_FPU_IEEE - _FPU_EXTENDED + _FPU_DOUBLE - _FPU_MASK_IM - _FPU_MASK_ZM - _FPU_MASK_OM);
-#else
- __fpu_control = _FPU_IEEE - _FPU_EXTENDED + _FPU_DOUBLE - _FPU_MASK_IM - _FPU_MASK_ZM - _FPU_MASK_OM;
- _FPU_SETCW(__fpu_control);
-#endif
-
-#else /* !_FPU_IEEE */
-
- fprintf(stderr, "\n%s\n%s\n%s\n%s\n",
- "WARNING: _uninit_f2c in libf2c does not know how",
- "to enable trapping on this system, so f2c's -trapuv",
- "option will not detect uninitialized variables unless",
- "you can enable trapping manually.");
- fflush(stderr);
-
-#endif /* _FPU_IEEE */
-#endif /* __mc68k__ */
- }
-#endif /* __linux__ */
-
-#ifdef __alpha
-#ifndef IEEE0_done
-#define IEEE0_done
-#include <machine/fpu.h>
- static void
-ieee0(Void)
-{
- ieee_set_fp_control(IEEE_TRAP_ENABLE_INV);
- }
-#endif /*IEEE0_done*/
-#endif /*__alpha*/
-
-#ifdef __hpux
-#define IEEE0_done
-#define _INCLUDE_HPUX_SOURCE
-#include <math.h>
-
-#ifndef FP_X_INV
-#include <fenv.h>
-#define fpsetmask fesettrapenable
-#define FP_X_INV FE_INVALID
-#endif
-
- static void
-ieee0(Void)
-{
- fpsetmask(FP_X_INV);
- }
-#endif /*__hpux*/
-
-#ifdef _AIX
-#define IEEE0_done
-#include <fptrap.h>
-
- static void
-ieee0(Void)
-{
- fp_enable(TRP_INVALID);
- fp_trap(FP_TRAP_SYNC);
- }
-#endif /*_AIX*/
-
-#ifdef __sun
-#define IEEE0_done
-#include <ieeefp.h>
-
- static void
-ieee0(Void)
-{
- fpsetmask(FP_X_INV);
- }
-#endif /*__sparc*/
-
-#ifndef IEEE0_done
- static void
-ieee0(Void) {}
-#endif
//GO.SYSIN DD libF77/uninit.c
echo libF77/arithchk.c 1>&2
sed >libF77/arithchk.c <<'//GO.SYSIN DD libF77/arithchk.c' 's/^-//'
-/****************************************************************
-Copyright (C) 1997, 1998, 2000 Lucent Technologies
-All Rights Reserved
-
-Permission to use, copy, modify, and distribute this software and
-its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the name of Lucent or any of its entities
-not be used in advertising or publicity pertaining to
-distribution of the software without specific, written prior
-permission.
-
-LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
-INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
-IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
-SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
-IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
-ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
-THIS SOFTWARE.
-****************************************************************/
-
-/* Try to deduce arith.h from arithmetic properties. */
-
-#include <stdio.h>
-#include <math.h>
-#include <errno.h>
-
-#ifdef NO_FPINIT
-#define fpinit_ASL()
-#else
-#ifndef KR_headers
-extern
-#ifdef __cplusplus
- "C"
-#endif
- void fpinit_ASL(void);
-#endif /*KR_headers*/
-#endif /*NO_FPINIT*/
-
- static int dalign;
- typedef struct
-Akind {
- char *name;
- int kind;
- } Akind;
-
- static Akind
-IEEE_8087 = { "IEEE_8087", 1 },
-IEEE_MC68k = { "IEEE_MC68k", 2 },
-IBM = { "IBM", 3 },
-VAX = { "VAX", 4 },
-CRAY = { "CRAY", 5};
-
- static double t_nan;
-
- static Akind *
-Lcheck()
-{
- union {
- double d;
- long L[2];
- } u;
- struct {
- double d;
- long L;
- } x[2];
-
- if (sizeof(x) > 2*(sizeof(double) + sizeof(long)))
- dalign = 1;
- u.L[0] = u.L[1] = 0;
- u.d = 1e13;
- if (u.L[0] == 1117925532 && u.L[1] == -448790528)
- return &IEEE_MC68k;
- if (u.L[1] == 1117925532 && u.L[0] == -448790528)
- return &IEEE_8087;
- if (u.L[0] == -2065213935 && u.L[1] == 10752)
- return &VAX;
- if (u.L[0] == 1267827943 && u.L[1] == 704643072)
- return &IBM;
- return 0;
- }
-
- static Akind *
-icheck()
-{
- union {
- double d;
- int L[2];
- } u;
- struct {
- double d;
- int L;
- } x[2];
-
- if (sizeof(x) > 2*(sizeof(double) + sizeof(int)))
- dalign = 1;
- u.L[0] = u.L[1] = 0;
- u.d = 1e13;
- if (u.L[0] == 1117925532 && u.L[1] == -448790528)
- return &IEEE_MC68k;
- if (u.L[1] == 1117925532 && u.L[0] == -448790528)
- return &IEEE_8087;
- if (u.L[0] == -2065213935 && u.L[1] == 10752)
- return &VAX;
- if (u.L[0] == 1267827943 && u.L[1] == 704643072)
- return &IBM;
- return 0;
- }
-
-char *emptyfmt = ""; /* avoid possible warning message with printf("") */
-
- static Akind *
-ccheck()
-{
- union {
- double d;
- long L;
- } u;
- long Cray1;
-
- /* Cray1 = 4617762693716115456 -- without overflow on non-Crays */
- Cray1 = printf(emptyfmt) < 0 ? 0 : 4617762;
- if (printf(emptyfmt, Cray1) >= 0)
- Cray1 = 1000000*Cray1 + 693716;
- if (printf(emptyfmt, Cray1) >= 0)
- Cray1 = 1000000*Cray1 + 115456;
- u.d = 1e13;
- if (u.L == Cray1)
- return &CRAY;
- return 0;
- }
-
- static int
-fzcheck()
-{
- double a, b;
- int i;
-
- a = 1.;
- b = .1;
- for(i = 155;; b *= b, i >>= 1) {
- if (i & 1) {
- a *= b;
- if (i == 1)
- break;
- }
- }
- b = a * a;
- return b == 0.;
- }
-
- static int
-need_nancheck()
-{
- double t;
-
- errno = 0;
- t = log(t_nan);
- if (errno == 0)
- return 1;
- errno = 0;
- t = sqrt(t_nan);
- return errno == 0;
- }
-
-main()
-{
- FILE *f;
- Akind *a = 0;
- int Ldef = 0;
-
- fpinit_ASL();
-#ifdef WRITE_ARITH_H /* for Symantec's buggy "make" */
- f = fopen("arith.h", "w");
- if (!f) {
- printf("Cannot open arith.h\n");
- return 1;
- }
-#else
- f = stdout;
-#endif
-
- if (sizeof(double) == 2*sizeof(long))
- a = Lcheck();
- else if (sizeof(double) == 2*sizeof(int)) {
- Ldef = 1;
- a = icheck();
- }
- else if (sizeof(double) == sizeof(long))
- a = ccheck();
- if (a) {
- fprintf(f, "#define %s\n#define Arith_Kind_ASL %d\n",
- a->name, a->kind);
- if (Ldef)
- fprintf(f, "#define Long int\n#define Intcast (int)(long)\n");
- if (dalign)
- fprintf(f, "#define Double_Align\n");
- if (sizeof(char*) == 8)
- fprintf(f, "#define X64_bit_pointers\n");
-#ifndef NO_LONG_LONG
- if (sizeof(long long) < 8)
-#endif
- fprintf(f, "#define NO_LONG_LONG\n");
- if (a->kind <= 2) {
- if (fzcheck())
- fprintf(f, "#define Sudden_Underflow\n");
- t_nan = -a->kind;
- if (need_nancheck())
- fprintf(f, "#define NANCHECK\n");
- }
- return 0;
- }
- fprintf(f, "/* Unknown arithmetic */\n");
- return 1;
- }
-
-#ifdef __sun
-#ifdef __i386
-/* kludge for Intel Solaris */
-void fpsetprec(int x) { }
-#endif
-#endif
//GO.SYSIN DD libF77/arithchk.c
echo libF77/f77vers.c 1>&2
sed >libF77/f77vers.c <<'//GO.SYSIN DD libF77/f77vers.c' 's/^-//'
- char
-_libf77_version_f2c[] = "\n@(#) LIBF77 VERSION (f2c) 20021004\n";
-
-/*
-2.00 11 June 1980. File version.c added to library.
-2.01 31 May 1988. s_paus() flushes stderr; names of hl_* fixed
- [ d]erf[c ] added
- 8 Aug. 1989: #ifdefs for f2c -i2 added to s_cat.c
- 29 Nov. 1989: s_cmp returns long (for f2c)
- 30 Nov. 1989: arg types from f2c.h
- 12 Dec. 1989: s_rnge allows long names
- 19 Dec. 1989: getenv_ allows unsorted environment
- 28 Mar. 1990: add exit(0) to end of main()
- 2 Oct. 1990: test signal(...) == SIG_IGN rather than & 01 in main
- 17 Oct. 1990: abort() calls changed to sig_die(...,1)
- 22 Oct. 1990: separate sig_die from main
- 25 Apr. 1991: minor, theoretically invisible tweaks to s_cat, sig_die
- 31 May 1991: make system_ return status
- 18 Dec. 1991: change long to ftnlen (for -i2) many places
- 28 Feb. 1992: repair z_sqrt.c (scribbled on input, gave wrong answer)
- 18 July 1992: for n < 0, repair handling of 0**n in pow_[dr]i.c
- and m**n in pow_hh.c and pow_ii.c;
- catch SIGTRAP in main() for error msg before abort
- 23 July 1992: switch to ANSI prototypes unless KR_headers is #defined
- 23 Oct. 1992: fix botch in signal_.c (erroneous deref of 2nd arg);
- change Cabs to f__cabs.
- 12 March 1993: various tweaks for C++
- 2 June 1994: adjust so abnormal terminations invoke f_exit just once
- 16 Sept. 1994: s_cmp: treat characters as unsigned in comparisons.
- 19 Sept. 1994: s_paus: flush after end of PAUSE; add -DMSDOS
- 12 Jan. 1995: pow_[dhiqrz][hiq]: adjust x**i to work on machines
- that sign-extend right shifts when i is the most
- negative integer.
- 26 Jan. 1995: adjust s_cat.c, s_copy.c to permit the left-hand side
- of character assignments to appear on the right-hand
- side (unless compiled with -DNO_OVERWRITE).
- 27 Jan. 1995: minor tweak to s_copy.c: copy forward whenever
- possible (for better cache behavior).
- 30 May 1995: added subroutine exit(rc) integer rc. Version not changed.
- 29 Aug. 1995: add F77_aloc.c; use it in s_cat.c and system_.c.
- 6 Sept. 1995: fix return type of system_ under -DKR_headers.
- 19 Dec. 1995: s_cat.c: fix bug when 2nd or later arg overlaps lhs.
- 19 Mar. 1996: s_cat.c: supply missing break after overlap detection.
- 13 May 1996: add [lq]bitbits.c and [lq]bitshft.c (f90 bit intrinsics).
- 19 June 1996: add casts to unsigned in [lq]bitshft.c.
- 26 Feb. 1997: adjust functions with a complex output argument
- to permit aliasing it with input arguments.
- (For now, at least, this is just for possible
- benefit of g77.)
- 4 April 1997: [cz]_div.c: tweaks invisible on most systems (that may
- affect systems using gratuitous extra precision).
- 19 Sept. 1997: [de]time_.c (Unix systems only): change return
- type to double.
- 2 May 1999: getenv_.c: omit environ in favor of getenv().
- c_cos.c, c_exp.c, c_sin.c, d_cnjg.c, r_cnjg.c,
- z_cos.c, z_exp.c, z_log.c, z_sin.c: cope fully with
- overlapping arguments caused by equivalence.
- 3 May 1999: "invisible" tweaks to omit compiler warnings in
- abort_.c, ef1asc_.c, s_rnge.c, s_stop.c.
-
- 7 Sept. 1999: [cz]_div.c: arrange for compilation under
- -DIEEE_COMPLEX_DIVIDE to make these routines
- avoid calling sig_die when the denominator
- vanishes; instead, they return pairs of NaNs
- or Infinities, depending whether the numerator
- also vanishes or not. VERSION not changed.
- 15 Nov. 1999: s_rnge.c: add casts for the case of
- sizeof(ftnint) == sizeof(int) < sizeof(long).
- 10 March 2000: z_log.c: improve accuracy of Real(log(z)) for, e.g.,
- z near (+-1,eps) with |eps| small. For the old
- evaluation, compile with -DPre20000310 .
- 20 April 2000: s_cat.c: tweak argument types to accord with
- calls by f2c when ftnint and ftnlen are of
- different sizes (different numbers of bits).
- 4 July 2000: adjustments to permit compilation by C++ compilers;
- VERSION string remains unchanged.
- 29 Sept. 2000: dtime_.c, etime_.c: use floating-point divide.
- dtime_.d, erf_.c, erfc_.c, etime.c: for use with
- "f2c -R", compile with -DREAL=float.
- 23 June 2001: add uninit.c; [fi]77vers.c: make version strings
- visible as extern char _lib[fi]77_version_f2c[].
- 5 July 2001: modify uninit.c for __mc68k__ under Linux.
- 16 Nov. 2001: uninit.c: Linux Power PC logic supplied by Alan Bain.
- 18 Jan. 2002: fix glitches in qbit_bits(): wrong return type,
- missing ~ on y in return value.
- 14 March 2002: z_log.c: add code to cope with buggy compilers
- (e.g., some versions of gcc under -O2 or -O3)
- that do floating-point comparisons against values
- computed into extended-precision registers on some
- systems (such as Intel IA32 systems). Compile with
- -DNO_DOUBLE_EXTENDED to omit the new logic.
- 4 Oct. 2002: uninit.c: on IRIX systems, omit use of shell variables.
-*/
//GO.SYSIN DD libF77/f77vers.c
echo libF77/libF77.xsum 1>&2
sed >libF77/libF77.xsum <<'//GO.SYSIN DD libF77/libF77.xsum' 's/^-//'
-F77_aloc.c f74c1f61 678
-Notice 76f23b4 1212
-README fbd01e7d 7210
-abort_.c 1ef378f2 298
-arithchk.c efc0d389 4669
-c_abs.c fec22c59 272
-c_cos.c 18fc0ea3 354
-c_div.c f5424912 930
-c_exp.c 1b85b1fc 349
-c_log.c 28cdfed 384
-c_sin.c 1ccaedc8 350
-c_sqrt.c f1ee88d5 605
-cabs.c f3d3b5f2 494
-d_abs.c e58094ef 218
-d_acos.c e5ecf93d 245
-d_asin.c e12ceeff 245
-d_atan.c 53034db 245
-d_atn2.c ff8a1a78 271
-d_cnjg.c 1c27c728 255
-d_cos.c c0eb625 241
-d_cosh.c 11dc4adb 245
-d_dim.c e1ccb774 232
-d_exp.c 1879c41c 241
-d_imag.c fe9c703e 201
-d_int.c f5de3566 269
-d_lg10.c 1a1d7b77 291
-d_log.c 1b368adf 241
-d_mod.c f540cf24 688
-d_nint.c ff913b40 281
-d_prod.c ad4856b 207
-d_sign.c 9562fc5 266
-d_sin.c 6e3f542 241
-d_sinh.c 18b22950 245
-d_sqrt.c 17e1db09 245
-d_tan.c ec93ebdb 241
-d_tanh.c 1c55d15b 245
-derf_.c f85e74a3 239
-derfc_.c e96b7667 253
-dtime_.c c982be4 972
-ef1asc_.c e0576e63 521
-ef1cmc_.c ea5ad9e8 427
-erf_.c e82f7790 270
-erfc_.c ba65441 275
-etime_.c 19d1fdad 839
-exit_.c ff4baa3a 543
-f2ch.add ef66bf17 6060
-f77vers.c 13362f51 4740
-getarg_.c f182a268 562
-getenv_.c ff3b797c 1217
-h_abs.c e4443109 218
-h_dim.c c6e48bc 230
-h_dnnt.c f6bb90e 294
-h_indx.c ef8461eb 442
-h_len.c e8c3633 205
-h_mod.c 7355bd0 207
-h_nint.c f0da3396 281
-h_sign.c f1370ffd 266
-hl_ge.c ed792501 346
-hl_gt.c feeacbd9 345
-hl_le.c f6fb5d6e 346
-hl_lt.c 18501419 345
-i_abs.c 12ab51ab 214
-i_dim.c f2a56785 225
-i_dnnt.c 11748482 291
-i_indx.c fb59026f 430
-i_len.c 17d17252 203
-i_mod.c bef73ae 211
-i_nint.c e494b804 278
-i_sign.c fa015b08 260
-iargc_.c 49abda3 196
-l_ge.c f4710e74 334
-l_gt.c e8db94a7 333
-l_le.c c9c0a99 334
-l_lt.c 767e79f 333
-lbitbits.c 33fe981 1097
-lbitshft.c e81981d2 258
-main.c dc8ce96 2219
-makefile f4048935 4364
-pow_ci.c fa934cec 412
-pow_dd.c f004559b 276
-pow_di.c a4db539 448
-pow_hh.c d1a45a9 489
-pow_ii.c 1fcf2742 488
-pow_qq.c e6a32de6 516
-pow_ri.c e7d9fc2a 436
-pow_zi.c 1b894af7 851
-pow_zz.c f81a06b5 549
-qbitbits.c fdb9910e 1151
-qbitshft.c 873054d 258
-r_abs.c f471383c 206
-r_acos.c 1a6aca63 233
-r_asin.c e8555587 233
-r_atan.c eac25444 233
-r_atn2.c f611bea 253
-r_cnjg.c a8d7805 235
-r_cos.c fdef1ece 229
-r_cosh.c f05d1ae 233
-r_dim.c ee23e1a8 214
-r_exp.c 1da16cd7 229
-r_imag.c 166ad0f3 189
-r_int.c fc80b9a8 257
-r_lg10.c e876cfab 279
-r_log.c 2062254 229
-r_mod.c 187363fc 678
-r_nint.c 6edcbb2 269
-r_sign.c 1ae32441 248
-r_sin.c c3d968 229
-r_sinh.c 1090c850 233
-r_sqrt.c ffbb0625 233
-r_tan.c fe85179d 229
-r_tanh.c 10ffcc5b 233
-s_cat.c 3070507 1452
-s_cmp.c e69e8b60 722
-s_copy.c 1e258852 1024
-s_paus.c 245d604 1596
-s_rnge.c fd20c6b4 753
-s_stop.c ffa80b24 762
-sig_die.c fbcad8d6 701
-signal1.h0 1d43ee57 842
-signal_.c f3ef9cfc 299
-system_.c eae6254c 646
-uninit.c 183c9847 7170
-z_abs.c 1fa0640d 268
-z_cos.c facccd9b 363
-z_div.c 1abdf45a 907
-z_exp.c 1a8506e8 357
-z_log.c 6bf3b22 2729
-z_sin.c 1aa35b59 359
-z_sqrt.c 1864d867 581
//GO.SYSIN DD libF77/libF77.xsum
echo libF77/main.c 1>&2
sed >libF77/main.c <<'//GO.SYSIN DD libF77/main.c' 's/^-//'
-/* STARTUP PROCEDURE FOR UNIX FORTRAN PROGRAMS */
-
-#include "stdio.h"
-#include "signal1.h"
-
-#ifndef SIGIOT
-#ifdef SIGABRT
-#define SIGIOT SIGABRT
-#endif
-#endif
-
-#ifndef KR_headers
-#undef VOID
-#include "stdlib.h"
-#ifdef __cplusplus
-extern "C" {
-#endif
-#endif
-
-#ifndef VOID
-#define VOID void
-#endif
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-#ifdef NO__STDC
-#define ONEXIT onexit
-extern VOID f_exit();
-#else
-#ifndef KR_headers
-extern void f_exit(void);
-#ifndef NO_ONEXIT
-#define ONEXIT atexit
-extern int atexit(void (*)(void));
-#endif
-#else
-#ifndef NO_ONEXIT
-#define ONEXIT onexit
-extern VOID f_exit();
-#endif
-#endif
-#endif
-
-#ifdef KR_headers
-extern VOID f_init(), sig_die();
-extern int MAIN__();
-#define Int /* int */
-#else
-extern void f_init(void), sig_die(char*, int);
-extern int MAIN__(void);
-#define Int int
-#endif
-
-static VOID sigfdie(Sigarg)
-{
-Use_Sigarg;
-sig_die("Floating Exception", 1);
-}
-
-
-static VOID sigidie(Sigarg)
-{
-Use_Sigarg;
-sig_die("IOT Trap", 1);
-}
-
-#ifdef SIGQUIT
-static VOID sigqdie(Sigarg)
-{
-Use_Sigarg;
-sig_die("Quit signal", 1);
-}
-#endif
-
-
-static VOID sigindie(Sigarg)
-{
-Use_Sigarg;
-sig_die("Interrupt", 0);
-}
-
-static VOID sigtdie(Sigarg)
-{
-Use_Sigarg;
-sig_die("Killed", 0);
-}
-
-#ifdef SIGTRAP
-static VOID sigtrdie(Sigarg)
-{
-Use_Sigarg;
-sig_die("Trace trap", 1);
-}
-#endif
-
-
-int xargc;
-char **xargv;
-
-#ifdef __cplusplus
- }
-#endif
-
-#ifdef KR_headers
-main(argc, argv) int argc; char **argv;
-#else
-main(int argc, char **argv)
-#endif
-{
-xargc = argc;
-xargv = argv;
-signal1(SIGFPE, sigfdie); /* ignore underflow, enable overflow */
-#ifdef SIGIOT
-signal1(SIGIOT, sigidie);
-#endif
-#ifdef SIGTRAP
-signal1(SIGTRAP, sigtrdie);
-#endif
-#ifdef SIGQUIT
-if(signal1(SIGQUIT,sigqdie) == SIG_IGN)
- signal1(SIGQUIT, SIG_IGN);
-#endif
-if(signal1(SIGINT, sigindie) == SIG_IGN)
- signal1(SIGINT, SIG_IGN);
-signal1(SIGTERM,sigtdie);
-
-#ifdef pdp11
- ldfps(01200); /* detect overflow as an exception */
-#endif
-
-f_init();
-#ifndef NO_ONEXIT
-ONEXIT(f_exit);
-#endif
-MAIN__();
-#ifdef NO_ONEXIT
-f_exit();
-#endif
-exit(0); /* exit(0) rather than return(0) to bypass Cray bug */
-return 0; /* For compilers that complain of missing return values; */
- /* others will complain that this is unreachable code. */
-}
-#ifdef __cplusplus
-}
-#endif
//GO.SYSIN DD libF77/main.c
echo libF77/makefile 1>&2
sed >libF77/makefile <<'//GO.SYSIN DD libF77/makefile' 's/^-//'
-.SUFFIXES: .c .o
-CC = cc
-SHELL = /bin/sh
-CFLAGS = -O
-
-# If your system lacks onexit() and you are not using an
-# ANSI C compiler, then you should add -DNO_ONEXIT to CFLAGS,
-# e.g., by changing the above "CFLAGS =" line to
-# CFLAGS = -O -DNO_ONEXIT
-
-# On at least some Sun systems, it is more appropriate to change the
-# "CFLAGS =" line to
-# CFLAGS = -O -Donexit=on_exit
-
-# compile, then strip unnecessary symbols
-.c.o:
- $(CC) -c -DSkip_f2c_Undefs $(CFLAGS) $*.c
- ld -r -x -o $*.xxx $*.o
- mv $*.xxx $*.o
-## Under Solaris (and other systems that do not understand ld -x),
-## omit -x in the ld line above.
-## If your system does not have the ld command, comment out
-## or remove both the ld and mv lines above.
-
-MISC = F77_aloc.o main.o s_rnge.o abort_.o f77vers.o getarg_.o iargc_.o \
- getenv_.o signal_.o s_stop.o s_paus.o system_.o cabs.o\
- derf_.o derfc_.o erf_.o erfc_.o sig_die.o exit_.o uninit.o
-POW = pow_ci.o pow_dd.o pow_di.o pow_hh.o pow_ii.o pow_ri.o pow_zi.o pow_zz.o
-CX = c_abs.o c_cos.o c_div.o c_exp.o c_log.o c_sin.o c_sqrt.o
-DCX = z_abs.o z_cos.o z_div.o z_exp.o z_log.o z_sin.o z_sqrt.o
-REAL = r_abs.o r_acos.o r_asin.o r_atan.o r_atn2.o r_cnjg.o r_cos.o\