aboutsummaryrefslogtreecommitdiff
path: root/doc/ports/sun3_f77Obugs.doc
diff options
context:
space:
mode:
authorJoseph Hunkeler <jhunkeler@gmail.com>2015-07-08 20:46:52 -0400
committerJoseph Hunkeler <jhunkeler@gmail.com>2015-07-08 20:46:52 -0400
commitfa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 (patch)
treebdda434976bc09c864f2e4fa6f16ba1952b1e555 /doc/ports/sun3_f77Obugs.doc
downloadiraf-linux-fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4.tar.gz
Initial commit
Diffstat (limited to 'doc/ports/sun3_f77Obugs.doc')
-rw-r--r--doc/ports/sun3_f77Obugs.doc1666
1 files changed, 1666 insertions, 0 deletions
diff --git a/doc/ports/sun3_f77Obugs.doc b/doc/ports/sun3_f77Obugs.doc
new file mode 100644
index 00000000..1f06a3e5
--- /dev/null
+++ b/doc/ports/sun3_f77Obugs.doc
@@ -0,0 +1,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
+#===============================================================================
generated by cgit (git 2.34.1) at 2025-09-20 12:09:20 -0400