|
|
1.1 root 1: .data
2: .asciz "@(#)Fmuls.s 1.1 86/02/03 Copyr 1985 Sun Micro"
3: .even
4: .text
5:
6: | Copyright (c) 1985 by Sun Microsystems, Inc.
7:
8: #include "fpcrtdefs.h"
9:
10: /*
11: * ieee single floating multiply
12: * copyright 1981, 1982 Richard E. James III
13: * translated to SUN idiom 14 March 1983 rt
14: */
15:
16: /*
17: * entry conditions:
18: * first argument in d0
19: * second argument in d1
20: * exit conditions:
21: * result (4 bytes) in d0
22: *
23: * register conventions:
24: * d0 operand1/upper1
25: * d1 operand2/upper2
26: * d2 9/lower1
27: * d3 lower2
28: * d4 exponent
29: * d5 sign
30: */
31: SAVEMASK = 0x3c00 | registers d2-d5
32: RESTMASK = 0x3c
33: NSAVED = 6*4 | 6 registers * sizeof(register)
34:
35: RTENTRY(Fsqrs)
36: movel d0,d1 | Copy second argument.
37: bras Fmuls2
38: RTENTRY(Fmuls)
39: | save registers
40: Fmuls2:
41: moveml #SAVEMASK,sp@- | registers d2-d7
42: | save sign of result
43: movl d0,d5
44: eorl d1,d5 | sign of result
45: asll #1,d0 | toss sign
46: asll #1,d1 | EEmmmm0
47: cmpl d1,d0
48: | order operands (exponents at least)
49: blss eswap
50: exg d0,d1 | d1 = larger
51: | extract and check exponents
52: eswap: roll #8,d0
53: roll #8,d1 | mmmmm0ee
54: clrw d4
55: movb d0,d4
56: clrw d3
57: movb d1,d3
58: addw d3,d4 | result exp
59: cmpb #0xff, d1
60: beqs ofl | infinity or nan
61: tstb d0
62: beqs ufl | 0 or gu (denormalized)
63: | clear exponent; set hidden bit
64: movb #1,d0
65: rorl #1,d0
66: back: movb #1,d1
67: rorl #1,d1
68:
69: movl d0,d2 | d2 gets x.
70: movl d1,d3 | d3 gets y.
71: swap d0 | d0 gets xu.
72: swap d1 | d1 gets yu.
73: movw d1,d5 | d5 gets yu.
74: mulu d2,d1 | d1 gets xl*yu.
75: mulu d3,d2 | d2 gets xl*yl.
76: mulu d0,d3 | d3 gets xu*yl.
77: mulu d5,d0 | d0 gets xu*yu.
78: addl d3,d1 | d1 gets middle = xu*yl+xl*yu.
79: bccs 1$ | Branch if no carry occurred.
80: addl #0x10000,d0 | Propagate carry to upper product.
81: 1$:
82: swap d1 | d1 gets middle(m) (ml,mu).
83: clrl d3
84: movw d1,d3 | d3 gets (0,mu).
85: clrw d1 | d1 gets (ml,0).
86: addl d2,d1 | d1 gets lower part of final product.
87: addxl d3,d0 | d0 gets upper part of final product.
88: tstl d1
89: beqs 2$ | Branch if lower part is exact.
90: bset #0,d0 | Set sticky bit if lower part has bits.
91: 2$:
92: subw #126,d4 | toss extra bias
93: jbsr f_rcp | round check, pack
94:
95: | build answer
96: mbuild: rorl #8,d0
97: roxll #1,d5
98: roxrl #1,d0 | append sign
99:
100: | answer in d0
101: mexit: moveml sp@+,#RESTMASK
102: RET
103:
104: | EXCEPTION HANDLING
105: ofl: clrb d1
106: tstl d1 | larger mantissa
107: bnes mni | user larger nan
108: tstl d0
109: beqs m_gennan | 0*inf
110: mni: movb #0xff,d1 | inf or nan
111: movl d1,d0
112: bras mbuild
113: ufl: tstl d0 | mantissa of smaller
114: beqs mbuild
115: | normalizing mode is embodied int the next few lines:
116: bmis back
117: normden:subql #1,d4 | adj exponent
118: lsll #1,d0
119: bpls normden
120: bras back
121:
122: m_gennan:movl #0x7f800002, d0
123: bras mexit
124:
125: /*
126: * ieee single floating divide
127: * copyright 1981, Richard E. James III
128: * translated to SUN idiom 14 March 1983 rt
129: */
130:
131: /*
132: * entry conditions:
133: * first argument in d0
134: * second argument in d1
135: * exit conditions:
136: * result (4 bytes) in d0
137: *
138: * register conventions:
139: * d0 top; ab; rq
140: * d1 bot; c
141: * d2 q
142: * d3 bottom exp; d
143: * d4 top/ final exp
144: * d5 sign
145: */
146: |
147: | same as for multiply, above
148: | SAVEMASK = 0x3c00 | registers d2-d5
149: | RESTMASK = 0x3c
150: | NSAVED = 4*4 | 4 registers * sizeof(register)
151:
152: RTENTRY(Fdivs)
153: | save registers
154: moveml #SAVEMASK,sp@- | registers d2-d5
155: | determine sign
156: movl d0,d5
157: eorl d1,d5 | sign in bit 31
158: | split out exponent
159: roll #1,d0
160: roll #1,d1
161: roll #8,d0
162: roll #8,d1
163: clrw d3
164: clrw d4
165: movb d0,d4 | exp of top
166: movb d1,d3 | exp of bottom
167: andw #0xfe00,d0 | clear out s, exp
168: andw #0xfe00,d1 | clear out s, exp
169: | test exponents
170: addqb #1,d4 | top
171: subqw #1,d4
172: bles toperr
173: addqb #1,d0 | hidden bit
174: backtop:addqb #1,d3
175: subqw #1,d3 | bottom
176: bles boterr
177: addqb #1,d1 | hidden bit
178: | position mantissas
179: backbot:rorl #2,d1 | 01X...
180: rorl #4,d0 | 0001X...
181: | compute tentative exponent
182: subw d3,d4
183: | to compute ab/cd:
184: | first do ab/c -> q, remainder -> r
185: movw d1,d3 | save d
186: movw d3,d5 | d5 saves d.
187: swap d1 | get c
188: divu d1,d0 | ab/c 29/15->15 bits
189: movw d0,d2 | save q
190: mulu d2,d3 | q*d
191: clrw d0 | r in top
192: subl d3,d0 | r-q*d = +-31
193: asrl #2,d0 | avoid ofl
194: divs d1,d0 | more quotient
195: movl d0,d1 | d1 gets remainder in upper word.
196: movw d5,d3 | d3 gets d.
197: muls d0,d3 | d3 gets signed(q2)*unsigned(d).
198: btst #15,d5
199: beqs 99$ | Branch if d appeared positive in muls.
200: swap d3 | If d appeared negative, correct product.
201: addw d0,d3
202: swap d3
203: 99$: |
204: extl d2 | q
205: extl d0 | second quot
206: swap d2
207: asll #2,d0
208: addl d2,d0
209: asll #1,d0
210: clrw d1 | d1 gets remainder in upper, 0 lower.
211: subl d3,d1 | d1 gets revised remainder.
212: beqs adjexp | Branch if exact.
213: bmis decr | Branch if remainder negative.
214: bset #0,d0 | inexact => set sticky.
215: bras adjexp
216: decr:
217: subql #1,d0 | Subtract sticky bit for negative remainder.
218:
219: adjexp: | adjust exponent, round, check extremes, pack
220: addw #127,d4
221: jbsr f_rcp
222: | reposition and append sign
223: drepk: rorl #8,d0
224: lsll #1,d5 | sign -> x
225: roxrl #1,d0 | insert sign
226: dexit: moveml sp@+,#RESTMASK
227: RET
228:
229: | EXCEPTIONS
230: toperr: bnes 2$
231: |top is 0 or gu, normalize and return
232: 1$: subqw #1,d4
233: roll #1,d0
234: bhis 1$ | loop til normalized, fall if 0
235: addqw #1,d4
236: bras backtop | 0 or gu
237:
238: | top is inf or nan
239: 2$: cmpb d3,d4
240: beqs dinvop | both inf/nan -> nan
241: tstl d0
242: beqs geninf | inf/ ... = +- inf
243: bras dinvop | nan/... = nan
244:
245: boterr: beqs botlow | .../(0|gu)
246: | .../(inf|nan)
247: tstl d1
248: bnes dinvop | .../nan = nan
249: clrl d0 | .../inf = +-0
250: bras drepk
251: botlow: tstl d1
252: beqs 5$ | .../0
253: | .../gu:
254: 4$: subqw #1,d3
255: roll #1,d1
256: bccs 4$ | loop til normalized
257: addqw #1,d3
258: jra backbot
259:
260: | bottom is zero
261: 5$: tstl d0
262: beqs d_gennan | 0/0 = nan
263: | nonzero/0 = +-inf
264: | generate infinity for answer
265: geninf: movl #0xff,d0
266: bras drepk
267:
268: | invalid operand/ operation
269: dinvop: cmpl d0,d1
270: bcss 8$ | use larger nan
271: tstl d1
272: beqs d_gennan | both are infinity, generate a nan
273: exg d1,d0 | larger nan
274: 8$: lsrl #8,d0
275: lsrl #1,d0
276: bras bldnan | return nan
277:
278: d_gennan:moveq #4,d0 | nan 4
279: bldnan: orl #0x7f800000,d0
280: bras dexit
281:
282: SAVEMASK = 0x3f00
283: RESTMASK = 0x00fc
284:
285: EXP = d2
286: TYPE = d3
287: /* type values: */
288: ZERO = 1 | wonderful
289: GU = 2
290: PLAIN = 3
291: INF = 4
292: NAN = 5
293:
294: RTENTRY(Fscaleis)
295: moveml #SAVEMASK,sp@- | state save
296: movel d1,d4 | Save argument i.
297: movel d0,d1 | What a crock!
298: jbsr f_unpk
299: cmpb #PLAIN,TYPE | is it a funny number?
300: bgts gohome | yes -- return argument
301: cmpb #ZERO,TYPE
302: beqs gohome | is zero -- return arg
303: | normal path through here
304: movw EXP,d7
305: extl d7 | d7 gets long exponent.
306: addl d4,d7 | d7 gets modified exponent.
307: bvcs nooflo | Branch if no overflow.
308: bmis posov | Branch if positive overflow to -.
309: | Branch if negative overflow to +.
310: negov:
311: movw #-2000,EXP
312: bras gohome
313: posov:
314: movw #2000,EXP
315: bras gohome
316: nooflo:
317: cmpl #2000,d7
318: bges posov
319: cmpl #-2000,d7
320: bles negov
321: movw d7,EXP | Final OK exponent.
322: gohome:
323: jbsr f_pack
324: movel d1,d0 | What a crock!
325: gone: moveml sp@+,#RESTMASK
326: RET
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.