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
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
|
# f77 source programs and corresponding assembler code generated with
# "f77 -S -O -f68881" that cause run-time failure, where the corresponding
# unoptimized code does not.
#===============================================================================
# fprfmt.f:
integer function fprfmt (ival)
integer ival
logical ivalad
integer ctoi
integer stridx
integer*2 ch
integer*2 chrlwr
integer fd
integer ip
integer width
integer decpl
integer col
integer leftjy
integer radix
integer fmtste
integer ofilee
integer formar
integer*2 fillcr
integer*2 format(161 +1)
integer*2 obuf(1024+1)
integer sw0001
common /fmtcom/ fd,ip,width,decpl,col,leftjy,radix,fmtste, ofilee,
*formar,fillcr,format,obuf
integer*2 st0001(17)
integer*2 st0002(35)
integer*2 st0003(1)
save
integer iyy
data (st0001(iyy),iyy= 1, 8) / 98, 99,100,101,102,103,104,109/
data (st0001(iyy),iyy= 9,16) /111,114,115,116,117,119,120,122/
data (st0001(iyy),iyy=17,17) / 0/
data (st0002(iyy),iyy= 1, 8) / 87, 97,114,110,105,110,103, 58/
data (st0002(iyy),iyy= 9,16) / 32, 85,110,107,110,111,119,110/
data (st0002(iyy),iyy=17,24) / 32,102,111,114,109, 97,116, 32/
data (st0002(iyy),iyy=25,32) /116,121,112,101, 32, 99,104, 97/
data (st0002(iyy),iyy=33,35) /114, 10, 0/
data st0003 / 0/
sw0001=(fmtste)
goto 110
120 continue
ivalad = .false.
goto 111
130 continue
goto 2
140 continue
goto 3
150 continue
goto 4
160 continue
goto 5
170 continue
goto 6
180 continue
goto 7
110 continue
if (sw0001.lt.1.or.sw0001.gt.7) goto 111
goto (120,130,140,150,160,170,180),sw0001
111 continue
if (.not.(format(ip) .eq. 0 .or. format(ip) .ne. 37 )) goto 190
width = (-999)
decpl = (-999)
formar = (-999)
fillcr = 32
leftjy = 0
fmtste = 1
fprfmt = (1)
goto 100
190 continue
ip = ip + 1
191 continue
if (.not.(format(ip) .eq. 42 )) goto 200
ip = ip + 1
if (.not.(ivalad)) goto 210
fmtste = 2
fprfmt = (0 )
goto 100
210 continue
2 ivalad = .true.
if (.not.(ival .lt. 0)) goto 220
leftjy = 1
goto 221
220 continue
leftjy = 0
221 continue
fillcr = 32
width = abs (ival)
goto 201
200 continue
if (.not.(format(ip) .eq. 45)) goto 230
leftjy = 1
ip = ip + 1
goto 231
230 continue
leftjy = 0
231 continue
fillcr = 32
if (.not.(format(ip) .eq. 48)) goto 240
if (.not.((format(ip+1).ge.48.and.format(ip+1).le.57) .or
* . format(ip+1) .eq. 42 )) goto 250
fillcr = 48
ip = ip + 1
goto 251
250 continue
fillcr = 32
251 continue
240 continue
if (.not.(format(ip) .eq. 42 )) goto 260
ip = ip + 1
if (.not.(ivalad)) goto 270
fmtste = 3
fprfmt = (0 )
goto 100
270 continue
3 ivalad = .true.
if (.not.(ival .lt. 0)) goto 280
leftjy = 1
goto 281
280 continue
leftjy = 0
281 continue
width = abs (ival)
goto 261
260 continue
if (.not.(ctoi (format, ip, width) .le. 0)) goto 290
width = (-999)
290 continue
261 continue
201 continue
if (.not.(width .eq. 0)) goto 300
width = (-999)
300 continue
if (.not.(format(ip) .eq. 46)) goto 310
ip = ip + 1
if (.not.(format(ip) .eq. 42 )) goto 320
ip = ip + 1
if (.not.(ivalad)) goto 330
fmtste = 4
fprfmt = (0 )
goto 100
330 continue
4 ivalad = .true.
decpl = ival
goto 321
320 continue
if (.not.(ctoi (format, ip, decpl) .le. 0)) goto 340
decpl = (-999)
340 continue
321 continue
goto 311
310 continue
decpl = (-999)
311 continue
if (.not.(format(ip) .eq. 42 )) goto 350
ip = ip + 1
if (.not.(ivalad)) goto 360
fmtste = 5
fprfmt = (0 )
goto 100
360 continue
5 ivalad = .true.
formar = ival
goto 351
350 continue
formar = format(ip)
ip = ip + 1
351 continue
if (.not.((formar.ge.65.and.formar.le.90))) goto 370
formar = (formar+97-65)
370 continue
ch = formar
if (.not.(stridx (ch, st0001) .le. 0)) goto 380
call putlie (5, st0002)
call fmterr (st0003, format, ip-1)
formar = (-999)
goto 381
380 continue
if (.not.(formar .eq. 114 )) goto 390
ch = chrlwr (format(ip))
ip = ip + 1
if (.not.(ch .eq. 42 )) goto 400
if (.not.(ivalad)) goto 410
fmtste = 6
fprfmt = (0 )
goto 100
410 continue
6 ivalad = .true.
radix = ival
goto 401
400 continue
if (.not.((ch.ge.48.and.ch.le.57))) goto 420
radix = (ch-48)
goto 421
420 continue
if (.not.((ch.ge.97.and.ch.le.122))) goto 430
radix = ch - 97 + 10
goto 431
430 continue
radix = 10
ip = ip - 1
431 continue
421 continue
401 continue
goto 391
390 continue
if (.not.(formar .eq. 119 .or. formar .eq. 116 )) goto 440
ivalad = .false.
440 continue
391 continue
381 continue
if (.not.(ivalad)) goto 450
fmtste = 7
fprfmt = (0 )
goto 100
450 continue
7 ivalad = .true.
fmtste = 1
fprfmt = (1)
goto 100
100 return
end
c leftjy left_justify
c fmterr fmt_err
c fmtste fmt_state
c ivalad ival_already_used
c fillcr fill_char
c putlie putline
c ofilee ofile_type
c formar format_char
#-------------------------------------------------------------------------------
# fprfmt.s:
.data
.data1
.bss
.data
.globl _fprfmt_
.comm _fmtcom_,2416
.globl _ctoi_
.globl _stridx_
.globl _putlie_
.globl _fmterr_
.globl _chrlwr_
.align 4
.text
|#PROC# 07
.bss
.align 4
VAR_SEG1:
.skip 10
.data1
.align 2
L1D186:
.long 5
LF1 = 228
LS1 = 8432
LFF1 = 208
LSS1 = 0
LP1 = 20
.text
.globl _fprfmt_
_fprfmt_:
link a6,#-228
moveml #8432,sp@
movl a6@(8),a5
movl _fmtcom_+4,d4
movl VAR_SEG1+4,d5
cmpl #1,_fmtcom_+28
jge L77020
jra L77005
L77007:
moveq #1,d5
movl a5@,d7
jge L77043
movl d5,_fmtcom_+20
jra L77044
L77009:
moveq #1,d5
movl a5@,d7
jge L77078
movl d5,_fmtcom_+20
jra L77079
L77011:
moveq #1,d5
movl a5@,_fmtcom_+12
jra L77109
L77013:
moveq #1,d5
movl a5@,d7
jra L77118
L77015:
moveq #1,d5
movl a5@,_fmtcom_+24
jra LY00019
L77017:
moveq #1,d5
jra LY00006
L77018:
movl _fmtcom_+28,d0
moveq #8,d7
cmpl d7,d0
bcc L77005
addw d0,d0
movw pc@(6,d0:w),d0
jmp pc@(2,d0:w)
L1I1:
.word L77023-L1I1
.word L77004-L1I1
.word L77007-L1I1
.word L77009-L1I1
.word L77011-L1I1
.word L77013-L1I1
.word L77015-L1I1
.word L77017-L1I1
jra L77005
L77020:
cmpl #7,_fmtcom_+28
jle L77018
jra L77005
L77023:
jra L77005
L77030:
addql #1,d4
movl d4,d7
lea _fmtcom_+40,a0
movw a0@(0,d7:l:2),d0
extl d0
moveq #42,d6
cmpl d6,d0
jne L77035
addql #1,d7
movl d7,d4
tstl d5
jeq L77007
moveq #2,d6
jra LY00016
L77024:
movl #-999,_fmtcom_+8
movl #-999,_fmtcom_+12
movl #-999,_fmtcom_+36
movw #32,_fmtcom_+40
clrl _fmtcom_+20
LY00006:
moveq #1,d6
moveq #1,d7
jra LY00010
L77129:
movl d4,_fmtcom_+4
asll #1,d4
addl #_fmtcom_+40,d4
movl d4,sp@-
jbsr _chrlwr_
addqw #4,sp
movl _fmtcom_+4,d4
addql #1,d4
extl d0
movl d0,d7
moveq #42,d6
cmpl d6,d7
jne L77136
tstl d5
jeq L77015
moveq #6,d6
jra LY00016
L77136:
moveq #48,d6
cmpl d6,d7
jlt L77146
moveq #57,d6
cmpl d6,d7
jgt L77146
moveq #-48,d6
addl d6,d7
movl d7,_fmtcom_+24
jra LY00019
L77146:
moveq #97,d6
cmpl d6,d7
jlt L77152
moveq #122,d6
cmpl d6,d7
jgt L77152
moveq #-87,d6
addl d6,d7
movl d7,_fmtcom_+24
jra LY00019
L77152:
moveq #10,d7
movl d7,_fmtcom_+24
moveq #-1,d7
addl d7,d4
jra LY00019
LY00020:
movl d4,_fmtcom_+4
pea v.17
pea L1D186
jbsr _putlie_
addqw #8,sp
movl _fmtcom_+4,d0
moveq #-1,d7
addl d7,d0
movl d0,a6@(-20)
pea a6@(-20)
pea _fmtcom_+42
pea v.18
jbsr _fmterr_
lea sp@(12),sp
movl _fmtcom_+4,d4
movl #-999,_fmtcom_+36
LY00019:
tstl d5
jeq L77017
moveq #7,d6
jra LY00016
L77110:
addql #1,d4
tstl d5
jeq L77013
moveq #5,d6
jra LY00016
L77096:
addql #1,d7
movl d7,d4
tstl d5
jeq L77011
moveq #4,d6
LY00016:
moveq #0,d7
LY00010:
movl d7,d0
movl d6,_fmtcom_+28
movl d4,_fmtcom_+4
movl d5,VAR_SEG1+4
moveml a6@(-228),#8432
unlk a6
rts
L77004:
moveq #0,d5
L77005:
lea _fmtcom_+40,a0
movw a0@(0,d4:l:2),d0
extl d0
movl d0,d7
jeq L77024
moveq #37,d6
cmpl d6,d7
jeq L77030
jra L77024
L77035:
moveq #45,d4
cmpl d4,d6
jne L77052
moveq #1,d6
movl d6,_fmtcom_+20
addql #1,d7
jra L77053
L77043:
clrl _fmtcom_+20
L77044:
movw #32,_fmtcom_+40
tstl d7
jlt L77046
jra LY00023
L77088:
movl #-999,_fmtcom_+8
jra L77091
L77052:
clrl _fmtcom_+20
L77053:
movw #32,_fmtcom_+40
movl d7,d6
asll #1,d6
lea _fmtcom_+40,a0
movw a0@(0,d6:l),d0
extl d0
moveq #48,d4
cmpl d4,d0
jne L77057
lea _fmtcom_+42,a0
movw a0@(0,d6:l),d0
extl d0
movl d0,d4
moveq #48,d6
cmpl d6,d4
jlt L77061
moveq #57,d6
cmpl d6,d4
jgt L77061
jra L77058
L77057:
lea _fmtcom_+40,a0
movw a0@(0,d7:l:2),d0
extl d0
moveq #42,d6
cmpl d6,d0
jne L77070
addql #1,d7
movl d7,d4
tstl d5
jeq L77009
moveq #3,d6
jra LY00016
L77065:
movw #32,_fmtcom_+40
jra L77057
L77058:
movw #48,_fmtcom_+40
addql #1,d7
jra L77057
L77061:
moveq #42,d6
cmpl d6,d4
jne L77065
jra L77058
L77070:
movl d7,_fmtcom_+4
movl d7,_fmtcom_+4
pea _fmtcom_+8
pea _fmtcom_+4
pea _fmtcom_+42
jbsr _ctoi_
lea sp@(12),sp
moveq #0,d1
tstl d0
sle d1
negb d1
movl d1,a6@(-52)
movl _fmtcom_+4,d4
tstl d1
jeq LY00002
movl #-999,_fmtcom_+8
jra LY00002
L77078:
clrl _fmtcom_+20
L77079:
tstl d7
jge LY00023
L77046:
negl d7
LY00023:
movl d7,_fmtcom_+8
LY00002:
tstl _fmtcom_+8
jeq L77088
L77091:
lea _fmtcom_+40,a0
movw a0@(0,d4:l:2),d0
extl d0
moveq #46,d7
cmpl d7,d0
jne L77105
addql #1,d4
movl d4,d7
lea _fmtcom_+40,a0
movw a0@(0,d7:l:2),d0
extl d0
moveq #42,d6
cmpl d6,d0
jeq L77096
movl d7,_fmtcom_+4
movl d7,_fmtcom_+4
pea _fmtcom_+12
pea _fmtcom_+4
pea _fmtcom_+42
jbsr _ctoi_
lea sp@(12),sp
moveq #0,d1
tstl d0
sle d1
negb d1
movl d1,a6@(-48)
movl _fmtcom_+4,d4
tstl d1
jeq L77109
L77105:
movl #-999,_fmtcom_+12
L77109:
lea _fmtcom_+40,a0
movw a0@(0,d4:l:2),d0
extl d0
movl d0,d6
moveq #42,d7
cmpl d7,d6
jeq L77110
movl d6,d7
addql #1,d4
L77118:
moveq #65,d6
cmpl d6,d7
jlt L77123
moveq #90,d6
cmpl d6,d7
jgt L77123
moveq #32,d6
addl d6,d7
L77123:
movw d7,VAR_SEG1+8
movl d7,_fmtcom_+36
movl d4,_fmtcom_+4
pea v.16
pea VAR_SEG1+8
jbsr _stridx_
addqw #8,sp
moveq #0,d1
tstl d0
sle d1
negb d1
movl d1,a6@(-44)
movl _fmtcom_+4,d4
tstl d1
jne LY00020
cmpl #114,_fmtcom_+36
jeq L77129
cmpl #119,_fmtcom_+36
jeq L77017
cmpl #116,_fmtcom_+36
jne LY00019
jra L77017
.globl f68881_used
.data1
.align 4
v.16:
.long 0x620063,0x640065
.long 0x660067,0x68006d
.long 0x6f0072,0x730074
.long 0x750077,0x78007a
.word 0x0
.align 4
v.17:
.long 0x570061,0x72006e
.long 0x69006e,0x67003a
.long 0x200055,0x6e006b
.long 0x6e006f,0x77006e
.long 0x200066,0x6f0072
.long 0x6d0061,0x740020
.long 0x740079,0x700065
.long 0x200063,0x680061
.long 0x72000a
.word 0x0
.align 4
v.18:
.skip 2
#===============================================================================
# ==========================
# FORTRAN for get_next_image
# ==========================
integer function getnee (infile, recors, nrecs, image, szname)
integer infile
integer nrecs
integer szname
integer recors(3,100)
integer*2 image(szname+1)
integer nextnm
integer stat
logical flag1
logical flag2
logical flag3
integer*2 image0(63 +1)
integer clgfil
integer getney
integer xstrln
common /gnicom/ flag1, flag2
integer*2 st0001(6)
save
data st0001 / 46, 37, 48, 52,100, 0/
data flag3/.true./
if (.not.(flag1 .or. flag3)) goto 110
nextnm = -1
call rstgey ()
110 continue
if (.not.(nrecs .eq. 2147483647)) goto 120
stat = clgfil (infile, image, szname) #<--- Never executed
goto 121
120 continue
if (.not.(flag1)) goto 130
stat = clgfil (infile, image0, szname)
if (.not.(stat .eq. -2)) goto 140
getnee = (stat)
goto 100
140 continue
130 continue
stat = getney (recors, nextnm)
if (.not.(stat .ne. -2)) goto 150
call xstrcy(image0, image, szname)
call sprinf (image(xstrln(image)+1), szname, st0001)
call pargi (nextnm)
150 continue
121 continue
flag1 = .false.
flag3 = .false.
getnee = (stat)
goto 100
100 return
end
#====================================================================
#Optimized assembly
#====================================================================
_getnee_+4: moveml d4/d5/d6/d7,sp@
tstl _gnicom_
beqs _getnee_+0x30
bras _getnee_+0x20
_getnee_+0x12: movl d7,d0
moveml a6@(-0x50),d4/d5/d6/d7
unlk a6
rts
bras _getnee_+0x38
moveq #-1,d6
movl d6,ARR_SEG5+0x294
jsr _rstgey_
bras _getnee_+0x38
tstl v.150+0x90
bnes _getnee_+0x20
movl a6@(8),d4
movl a6@(0x18),d5
movl a6@(0x14),d6
movl a6@(0x10),a0
cmpl #0x7fffffff,a0@ <--------
beq _getnee_+0xd4 <-------- Causes return
tstl _gnicom_
beqs _getnee_+0x76
movl d5,sp@-
pea ARR_SEG5+0x298
movl d4,sp@-
bsrl _clgfil_
lea sp@(0xc),a7
movl d0,d7
moveq #-2,d4
cmpl d4,d7
beqs _getnee_+0x12
pea ARR_SEG5+0x294
movl a6@(0xc),sp@-
jsr _getney_
addqw #8,sp
movl d0,d7
moveq #-2,d4
cmpl d4,d7
beqs _getnee_+0xd4
movl d5,sp@-
movl d6,sp@-
pea ARR_SEG5+0x298
bsrl _xstrcy_
lea sp@(0xc),a7
pea v.150+0x84
movl d5,sp@-
movl d6,sp@-
bsrl _xstrln_
addqw #4,sp
asll #1,d0
addl d6,d0
movl d0,sp@-
bsrl _sprinf_
lea sp@(0xc),a7
pea ARR_SEG5+0x294
bsrl _pargi_
addqw #4,sp
_getnee_+0xd4: clrl _gnicom_
clrl v.150+0x90
bra _getnee_+0x12
_resete_: linkw a6,#0
movl #1,_gnicom_
unlk a6
rts
_addspc_: linkw a6,#-0xec
moveml d3/d4/d5/d6/d7/a3/a4/a5,sp@
fmovex fp7,a6@(-0xcc)
moveq #0,d6
movl a6@(0x14),a0
movl a0@,a5
tstl a5
bnes _addspc_+0x8e
moveq #-1,d6
bras _addspc_+0x8e
moveq #1,d4
movl a4@,d7
subl d4,d7
tstl d7
blt _addspc_+0xb4
#===============================================================================
# grcwcs.f:
subroutine grcscs (stream, sx, sy, wx, wy, wcs)
integer stream
real sx
real sy
real wx
real wy
integer wcs
logical Memb(1)
integer*2 Memc(1)
integer*2 Mems(1)
integer Memi(1)
integer*4 Meml(1)
real Memr(1)
double precision Memd(1)
complex Memx(1)
equivalence (Memb, Memc, Mems, Memi, Meml, Memr, Memd, Memx)
common /Mem/ Memd
integer w
integer tr
real mx
real my
real ct(2,4)
integer grcses
integer gtrint
save
tr = gtrint (stream)
call grcscc (sx, sy, mx, my)
if (.not.(memi(tr+16) .eq. 0)) goto 110
wcs = grcses (tr, mx, my)
goto 111
110 continue
wcs = memi(tr+16)
111 continue
w = ((tr)+154+(wcs)*11)
call grcsen (w, ct)
call grcnds (ct, mx, my, wx, wy)
100 return
end
subroutine grcsen (w, ct)
logical Memb(1)
integer*2 Memc(1)
integer*2 Mems(1)
integer Memi(1)
integer*4 Meml(1)
real Memr(1)
double precision Memd(1)
complex Memx(1)
equivalence (Memb, Memc, Mems, Memi, Meml, Memr, Memd, Memx)
common /Mem/ Memd
integer w
real ct(2,4)
real worign
real scale
real m1
real m2
real w1
real w2
integer transn
integer ax
real elogr
save
do 110 ax = 1, 2
if (.not.(ax .eq. 1)) goto 120
transn = memi(w+8)
w1 = memr(w)
w2 = memr(w+1)
m1 = memr(w+4)
m2 = memr(w+5)
goto 121
120 continue
transn = memi(w+9)
w1 = memr(w+2)
w2 = memr(w+3)
m1 = memr(w+6)
m2 = memr(w+7)
121 continue
if (.not.(transn .eq. 0 )) goto 130
worign = w1
scale = (m2 - m1) / (w2 - w1)
goto 131
130 continue
if (.not.(transn .eq. 1 .and. w1 .gt. 0 .and. w2 .gt. 0))
* goto 140
worign = log10 (w1)
scale = (m2 - m1) / (log10(w2) - worign)
goto 141
140 continue
worign = elogr (w1)
scale = (m2 - m1) / (elogr(w2) - worign)
141 continue
131 continue
ct(ax,1) = transn
ct(ax,2) = scale
ct(ax,3) = worign
ct(ax,4) = m1
110 continue
111 continue
100 return
end
subroutine grcwcc (ct, wx, wy, mx, my)
real wx
real wy
real mx
real my
real ct(2,4)
real v
integer transn
integer ax
real elogr
save
do 110 ax = 1, 2
transn = nint (ct(ax,1))
if (.not.(ax .eq. 1)) goto 120
v = wx
goto 121
120 continue
v = wy
121 continue
if (.not.(transn .eq. 0 )) goto 130
goto 131
130 continue
if (.not.(transn .eq. 1)) goto 140
v = log10 (v)
goto 141
140 continue
v = elogr (v)
141 continue
131 continue
v = ((v - ct(ax,3)) * ct(ax,2)) + ct(ax,4)
if (.not.(ax .eq. 1)) goto 150
mx = v
goto 151
150 continue
my = v
151 continue
110 continue
111 continue
100 return
end
subroutine grcnds (ct, mx, my, wx, wy)
real mx
real my
real wx
real wy
real ct(2,4)
real v
integer transn
integer ax
real aelogr
save
do 110 ax = 1, 2
transn = nint (ct(ax,1))
if (.not.(ax .eq. 1)) goto 120
v = mx
goto 121
120 continue
v = my
121 continue
v = ((v - ct(ax,4)) / ct(ax,2)) + ct(ax,3)
if (.not.(transn .eq. 0 )) goto 130
goto 131
130 continue
if (.not.(transn .eq. 1)) goto 140
v = 10.0 ** v
goto 141
140 continue
v = aelogr (v)
141 continue
131 continue
if (.not.(ax .eq. 1)) goto 150
wx = v
goto 151
150 continue
wy = v
151 continue
110 continue
111 continue
100 return
end
integer function grcses (tr, mx, my)
logical Memb(1)
integer*2 Memc(1)
integer*2 Mems(1)
integer Memi(1)
integer*4 Meml(1)
real Memr(1)
double precision Memd(1)
complex Memx(1)
equivalence (Memb, Memc, Mems, Memi, Meml, Memr, Memd, Memx)
common /Mem/ Memd
integer tr
real mx
real my
integer w
integer wcs
integer closes
real tol
real sx1
real sx2
real sy1
real sy2
real distae
real olddie
real xcen
real ycen
integer nin
integer in(16 )
save
nin = 0
closes = 1
olddie = 1.0
tol = (1.192e-7) * 10.0
do 110 wcs = 1, 16
w = ((tr)+154+(wcs)*11)
sx1 = memr(w+4)
sx2 = memr(w+5)
sy1 = memr(w+6)
sy2 = memr(w+7)
xcen = (sx1 + sx2) / 2.0
ycen = (sy1 + sy2) / 2.0
if (.not.(abs ((sx2-sx1) - 1.0) .lt. tol .and. abs ((sy2-sy1
* ) - 1.0) .lt. tol)) goto 120
goto 110
120 continue
distae = ((mx - xcen) ** 2) + ((my - ycen) ** 2)
if (.not.(distae .le. olddie)) goto 130
closes = wcs
olddie = distae
130 continue
if (.not.(mx .ge. sx1 .and. mx .le. sx2 .and. my .ge. sy1 .
* and. my .le. sy2)) goto 140
nin = nin + 1
in(nin) = wcs
140 continue
110 continue
111 continue
if (.not.(nin .eq. 1)) goto 150
grcses = (in(1))
goto 100
150 continue
grcses = (closes)
goto 100
100 return
end
c gtrint gtr_init
c grcses grc_selectwcs
c grcscs grc_scrtowcs
c olddie old_distance
c grcsen grc_settran
c transn transformation
c distae distance
c grcscc grc_scrtondc
c closes closest_wcs
c grcnds grc_ndctowcs
c grcwcc grc_wcstondc
c worign worigin
#-------------------------------------------------------------------------------
# grcwcs.s:
.data
.data1
.bss
.data
.data1
.bss
.data
.data1
.bss
.data
.data1
.bss
.data
.data1
.bss
.data
.globl _grcscs_
.comm _mem_,8
.globl _gtrint_
.globl _grcscc_
.globl _grcses_
.globl _grcsen_
.globl _grcnds_
.globl _elogr_
.globl _grcwcc_
.globl _i_nint
.globl _aelogr_
.align 4
.text
|#PROC# 07
.bss
.align 4
VAR_SEG1:
.skip 16
.bss
.align 4
ARR_SEG1:
.skip 32
LF1 = 20
LS1 = 128
LFF1 = 16
LSS1 = 0
LP1 = 28
.text
.globl _grcscs_
_grcscs_:
link a6,#-20
movl d7,sp@
movl a6@(8),sp@-
jbsr _gtrint_
addqw #4,sp
movl d0,VAR_SEG1+4
pea VAR_SEG1+12
pea VAR_SEG1+8
movl a6@(16),sp@-
movl a6@(12),sp@-
jbsr _grcscc_
lea sp@(16),sp
movl VAR_SEG1+4,d0
lea _mem_+60,a0
movl a0@(0,d0:l:4),d7
jne L77006
pea VAR_SEG1+12
pea VAR_SEG1+8
pea VAR_SEG1+4
jbsr _grcses_
lea sp@(12),sp
movl a6@(28),a0
movl d0,a0@
jra L77007
L77006:
movl a6@(28),a0
movl d7,a0@
L77007:
movl a6@(28),a0
movl a0@,d0
movl d0,d1
addl d1,d1
addl d1,d0
asll #2,d1
addl d1,d0
movl VAR_SEG1+4,d1
addl #154,d1
addl d1,d0
movl d0,VAR_SEG1
pea ARR_SEG1
pea VAR_SEG1
jbsr _grcsen_
addqw #8,sp
movl a6@(24),sp@-
movl a6@(20),sp@-
pea VAR_SEG1+12
pea VAR_SEG1+8
pea ARR_SEG1
jbsr _grcnds_
lea sp@(20),sp
movl a6@(-20),d7
unlk a6
rts
|#PROC# 07
.bss
.align 4
VAR_SEG2:
.skip 32
.data1
.align 2
L2D24:
.long 0
.data1
.align 2
L2D22:
.long 0
LF2 = 432
LS2 = 15612
LFF2 = 392
LSS2 = 63
LP2 = 12
.text
.globl _grcsen_
_grcsen_:
link a6,#-432
moveml #15612,sp@
fmovem #63,a6@(-392)
moveq #1,d7
movl d7,VAR_SEG2+20
movl a6@(12),d0
moveq #20,d7
addl d7,d0
movl d0,a6@(-4)
movl a6@(12),d0
moveq #12,d7
addl d7,d0
movl d0,a6@(-8)
movl a6@(12),d0
addql #4,d0
movl d0,a6@(-12)
movl a6@(12),d0
moveq #-4,d7
addl d7,d0
movl d0,a6@(-16)
movl a6@(8),a0
movl a0@,d7
asll #2,d7
movl #_mem_+16,d0
addl d7,d0
movl d0,a6@(-20)
movl #_mem_+12,d0
addl d7,d0
movl d0,a6@(-24)
movl #_mem_,d0
addl d7,d0
movl d0,a6@(-28)
movl #_mem_+-4,d0
addl d7,d0
movl d0,a6@(-32)
movl #_mem_+28,d0
addl d7,d0
movl d0,a6@(-36)
movl #_mem_+24,d0
addl d7,d0
movl d0,a6@(-40)
movl #_mem_+20,d2
addl d7,d2
movl #_mem_+8,d3
addl d7,d3
movl #_mem_+4,d4
addl d7,d4
movl #_mem_+32,d5
addl d7,d5
movl VAR_SEG2+20,d6
asll #2,d6
movl d6,a2
addl a6@(-4),a2
movl d6,a3
addl a6@(-16),a3
movl d6,a4
addl a6@(-12),a4
movl d6,d0
addl a6@(-8),d0
movl d0,a5
L77011:
moveq #4,d7
cmpl d7,d6
jne L77015
movl a6@(-36),a0
movl a0@,d7
movl a6@(-32),a0
fmoves a0@,fp3
movl a6@(-28),a0
fmoves a0@,fp2
movl a6@(-24),a0
fmoves a0@,fp7
movl a6@(-20),a0
jra LY00000
L77015:
movl d5,a0
movl a0@,d7
movl d4,a0
fmoves a0@,fp3
movl d3,a0
fmoves a0@,fp2
movl d2,a0
fmoves a0@,fp7
movl a6@(-40),a0
LY00000:
fmoves a0@,fp5
tstl d7
jne L77020
fmovex fp3,fp6
fmovex fp5,fp0
fsubx fp7,fp0
fmovex fp2,fp1
fsubx fp3,fp1
jra LY00001
L77020:
cmpl #1,d7
jne L77027
fcmps L2D24,fp3
fjngt L77027
fcmps L2D22,fp2
fjngt L77027
flog10x fp3,fp0
fmovex fp0,fp6
fmovex fp5,fp0
fsubx fp7,fp0
flog10x fp2,fp1
fsubx fp6,fp1
LY00001:
fdivx fp1,fp0
fmovex fp0,fp4
L77021:
fmovel d7,fp0
fmoves fp0,a3@+
fmoves fp4,a4@+
fmoves fp6,a5@+
fmoves fp7,a2@+
addql #4,d6
moveq #8,d7
cmpl d7,d6
jle L77011
fmovem a6@(-392),#63
moveml a6@(-432),#15612
unlk a6
rts
L77027:
fmoves fp3,VAR_SEG2+12
pea VAR_SEG2+12
jbsr _elogr_
addqw #4,sp
fmoves d0,fp6
fmoves fp2,VAR_SEG2+16
pea VAR_SEG2+16
jbsr _elogr_
addqw #4,sp
fmoves d0,fp0
fsubx fp6,fp0
fsubx fp7,fp5
fdivx fp0,fp5
fmovex fp5,fp4
jra L77021
|#PROC# 07
.bss
.align 4
VAR_SEG3:
.skip 12
LF3 = 264
LS3 = 15608
LFF3 = 228
LSS3 = 7
LP3 = 12
.text
.globl _grcwcc_
_grcwcc_:
link a6,#-264
moveml #15608,sp@
fmovem #7,a6@(-228)
moveq #1,d7
movl a6@(20),a2
movl a6@(24),d3
movl a6@(8),d6
movl d6,d0
moveq #20,d5
addl d5,d0
movl d0,a6@(-4)
movl d6,d0
addql #4,d0
movl d0,a6@(-8)
movl d6,d0
moveq #12,d5
addl d5,d0
movl d0,a6@(-12)
movl a6@(12),a0
fmoves a0@,fp5
movl a6@(16),a0
fmoves a0@,fp6
moveq #-4,d5
addl d5,d6
movl d6,a6@(-24)
asll #2,d7
movl d7,a3
addl a6@(-4),a3
movl d7,d4
addl d6,d4
movl d7,a4
addl d0,a4
movl d7,a5
addl a6@(-8),a5
L77034:
movl d4,sp@-
jbsr _i_nint
addqw #4,sp
movl d0,d6
moveq #0,d0
moveq #4,d5
cmpl d5,d7
seq d0
negb d0
movl d0,d5
jeq L77038
fmovex fp5,fp7
jra L77039
L77038:
fmovex fp6,fp7
L77039:
tstl d6
jeq LY00002
cmpl #1,d6
jne L77048
flog10x fp7,fp0
fmovex fp0,fp7
jra LY00002
L77050:
fmoves fp7,a2@
jra L85
L77048:
fmoves fp7,VAR_SEG3
pea VAR_SEG3
jbsr _elogr_
addqw #4,sp
fmoves d0,fp7
LY00002:
fsubs a4@,fp7
fmuls a5@,fp7
fadds a3@,fp7
tstl d5
jne L77050
movl d3,a0
fmoves fp7,a0@
L85:
addql #4,d7
addqw #4,a5
addqw #4,a4
addql #4,d4
addqw #4,a3
moveq #8,d6
cmpl d6,d7
jle L77034
fmovem a6@(-228),#7
moveml a6@(-264),#15608
unlk a6
rts
|#PROC# 07
.bss
.align 4
VAR_SEG4:
.skip 12
LF4 = 264
LS4 = 15608
LFF4 = 228
LSS4 = 7
LP4 = 12
.text
.globl _grcnds_
_grcnds_:
link a6,#-264
moveml #15608,sp@
fmovem #7,a6@(-228)
moveq #1,d7
movl a6@(20),a2
movl a6@(24),d3
movl a6@(8),d6
movl d6,d0
moveq #12,d5
addl d5,d0
movl d0,a6@(-4)
movl d6,d0
addql #4,d0
movl d0,a6@(-8)
movl d6,d0
moveq #20,d5
addl d5,d0
movl d0,a6@(-12)
movl a6@(12),a0
fmoves a0@,fp5
movl a6@(16),a0
fmoves a0@,fp6
moveq #-4,d5
addl d5,d6
movl d6,a6@(-24)
asll #2,d7
movl d7,a3
addl a6@(-4),a3
movl d7,d4
addl d6,d4
movl d7,a4
addl d0,a4
movl d7,a5
addl a6@(-8),a5
L77060:
movl d4,sp@-
jbsr _i_nint
addqw #4,sp
movl d0,d6
moveq #0,d0
moveq #4,d5
cmpl d5,d7
seq d0
negb d0
movl d0,d5
jeq L77064
fmovex fp5,fp7
jra L77065
L77064:
fmovex fp6,fp7
L77065:
fsubs a4@,fp7
fdivs a5@,fp7
fadds a3@,fp7
tstl d6
jeq LY00004
cmpl #1,d6
jne L77074
ftentoxx fp7,fp0
fmovex fp0,fp7
jra LY00004
L77076:
fmoves fp7,a2@
jra L121
L77074:
fmoves fp7,VAR_SEG4
pea VAR_SEG4
jbsr _aelogr_
addqw #4,sp
fmoves d0,fp7
LY00004:
tstl d5
jne L77076
movl d3,a0
fmoves fp7,a0@
L121:
addql #4,d7
addqw #4,a5
addqw #4,a4
addql #4,d4
addqw #4,a3
moveq #8,d6
cmpl d6,d7
jle L77060
fmovem a6@(-228),#7
moveml a6@(-264),#15608
unlk a6
rts
|#PROC# 07
.bss
.align 4
VAR_SEG5:
.skip 52
.bss
.align 4
ARR_SEG5:
.skip 64
.data1
.align 2
L5D70:
.single 0r1.00000000000000000e+00
.data1
.align 2
L5D68:
.single 0r1.00000000000000000e+01
.data1
.align 2
L5D67:
.single 0r1.19200000000000000e-07
.data1
.align 2
L5D49:
.single 0r2.00000000000000000e+00
.data1
.align 2
L5D41:
.single 0r-1.00000000000000000e+00
LF5 = 356
LS5 = 8444
LFF5 = 328
LSS5 = 63
LP5 = 8
.text
.globl _grcses_
_grcses_:
link a6,#-356
moveml #8444,sp@
fmovem #63,a6@(-328)
moveq #0,d3
moveq #1,d2
movl L5D70,VAR_SEG5+4
fmoves L5D68,fp0
fmuls L5D67,fp0
fmoves fp0,VAR_SEG5+40
moveq #1,d6
movl a6@(16),a0
movl a0@,a6@(-60)
movl a6@(12),a0
fmoves a0@,fp2
movl a6@(8),a0
movl a0@,d0
addl #154,d0
movl d0,a6@(-36)
movl d3,d0
asll #2,d0
movl d6,d5
movl d5,d1
addl d1,d1
addl d1,d5
asll #2,d1
addl d1,d5
addl #ARR_SEG5+-4,d0
movl d0,a5
movl d5,d4
addl a6@(-36),d4
jra L77087
LY00009:
moveq #1,d7
cmpl d7,d3
jne L77108
movl ARR_SEG5,d7
LY00008:
movl d7,d0
fmovem a6@(-328),#63
moveml a6@(-356),#8444
unlk a6
rts
LY00006:
addql #1,d6
moveq #11,d7
addl d7,d5
addl d7,d4
cmpl #176,d5
jgt LY00009
L77087:
movl d4,d7
asll #2,d7
lea _mem_+12,a0
fmoves a0@(0,d7:l),fp6
lea _mem_+16,a0
fmoves a0@(0,d7:l),fp4
lea _mem_+20,a0
fmoves a0@(0,d7:l),fp5
lea _mem_+24,a0
fmoves a0@(0,d7:l),fp3
fmovex fp6,fp0
faddx fp4,fp0
fdivs L5D49,fp0
fmoves fp0,VAR_SEG5+28
fmovex fp5,fp0
faddx fp3,fp0
fdivs L5D49,fp0
fmoves fp0,VAR_SEG5+32
fmovex fp4,fp7
fsubx fp6,fp7
fadds L5D41,fp7
fabsx fp7,fp0
fcmps VAR_SEG5+40,fp0
fjnlt L77092
fmovex fp3,fp7
fsubx fp5,fp7
fadds L5D41,fp7
fabsx fp7,fp0
fcmps VAR_SEG5+40,fp0
fjlt LY00006
L77092:
fmovex fp2,fp7
fsubs VAR_SEG5+28,fp7
fmoves fp7,a6@(-20)
fmoves a6@(-60),fp7
fsubs VAR_SEG5+32,fp7
fmoves fp7,a6@(-24)
fmoves a6@(-20),fp7
fmulx fp7,fp7
fmoves a6@(-24),fp1
fmulx fp1,fp1
faddx fp1,fp7
fcmps VAR_SEG5+4,fp7
fjnle L77096
movl d6,d2
fmoves fp7,VAR_SEG5+4
L77096:
fcmpx fp6,fp2
fjnge LY00006
fcmpx fp4,fp2
fjnle LY00006
fcmps a6@(-60),fp5
fjnle LY00006
fcmps a6@(-60),fp3
fjnge LY00006
addql #1,d3
addqw #4,a5
movl d6,a5@
jra LY00006
L77108:
movl d2,d7
jra LY00008
.globl f68881_used
.data1
#===============================================================================
|
