|
|
1.1 root 1: head 1.2;
2: access ;
3: symbols ;
4: locks bin:1.2;
5: comment @/ @;
6:
7:
8: 1.2
9: date 92.05.07.23.26.58; author bin; state Exp;
10: branches ;
11: next 1.1;
12:
13: 1.1
14: date 92.05.07.23.25.36; author bin; state Exp;
15: branches ;
16: next ;
17:
18:
19: desc
20: @steve 5/7/92
21: Initial MWC RCS revision.
22: ,.
23: @
24:
25:
26: 1.2
27: log
28: @steve 5/7/92
29: Deleted code to adjust result for negative arguments.
30: According to ANSI, -1.15 should return -1 + -.15, not -2 + .85.
31: @
32: text
33: @////////
34: /
35: / Intel 8086 C runtime.
36: / Split a double into the fraction and whole integer parts.
37: / SMALL model.
38: /
39: ////////
40:
41: .globl modf_
42: .globl _fpac_
43: .globl dpush
44: .globl dladd
45: .globl dlsub
46: .globl dzero
47:
48: ////////
49: /
50: / double
51: / modf(d, *ip);
52: / double d;
53: / double *ip;
54: / The "integer part" of the double "d" is stored
55: / indirectly through "ip". The remaining fractional part
56: / is returned. The return value is always positive.
57: /
58: ////////
59:
60: d = 8 / Double argument
61: ip = 16 / Whole part pointer.
62:
63: EXP = -2 / Exponant.
64: SIGN = -4 / Sign flag.
65: CLAIM = 4 / # of bytes of autos.
66:
67: modf_: push si / Standard
68: push di / C
69: push bp / calling
70: mov bp,sp / sequence.
71:
72: sub sp,$CLAIM / Claim auto space
73: cld / Incrementing.
74:
75: lea si,d(bp) / Copy the "d" argument
76: mov di,ip(bp) / into the
77: movsw / integer return
78: movsw / value
79: movsw / output
80: movsw / area
81:
82: mov ax,d+6(bp) / Get the first word.
83: shl ax,$1 / Slide off the sign and
84: rclb SIGN(bp),$1 / save it.
85: movb al,ah / Save the exponant
86: subb ah,ah / in the ax,
87: sub ax,$0x80 / unbias it, and
88: mov EXP(bp),ax / save it away.
89:
90: / If the exponant is <= 0, then there is no
91: / integer part. Set the integer part to 0.0, and get set
92: / to return the argument as the fractional part.
93:
94: jg 0f / Jump if exponant > 0
95:
96: sub ax,ax / Set
97: mov di,ip(bp) / the
98: stosw / integer
99: stosw / part
100: stosw / to
101: stosw / zero.
102:
103: lea si,d(bp) / Copy
104: mov di,$_fpac_ / the
105: movsw / argument
106: movsw / to
107: movsw / the
108: movsw / return area.
109: jmp 1f / Done.
110:
111: / If the exponant is > 56 then there are no fractional bits
112: / at all. The integer part is correct. Zero out the floating point
113: / return value.
114:
115: 0: cmp ax,$56 / Any fractional bits ?
116: jl 0f / Yes.
117:
118: call dzero / Zero the _fpac_.
119: jmp 1f / Done.
120:
121: / Clear 56-exp bits, starting at the right hand end of the
122: / integer value. Clear as many full bytes as you can, then build a
123: / mask and get the rest.
124:
125: 0: neg ax / Figure out
126: add ax,$56 / 56-exp.
127: mov di,ip(bp) / Point di at low end.
128:
129: 0: sub ax,$8 / Is there a full byte ?
130: jl 0f / Nope.
131: movb (di),$0 / Clear 8 bits.
132: inc di / Move to next byte and
133: jmp 0b / try again.
134:
135: 0: add ax,$8 / Figure out
136: movb cl,al / the
137: movb al,$0xFF / correct mask to
138: shlb al,cl / clear the rest, and
139: andb (di),al / do it.
140:
141: / Scoop up the number. Shift the binary point to just above
142: / the hidden bit location, then shift it additional times to get
143: / it normalized.
144:
145: mov cx,EXP(bp) / Get exponant.
146:
147: movb dl,d+6(bp) / Scoop
148: mov ax,d+4(bp) / up
149: mov si,d+2(bp) / the
150: mov di,d+0(bp) / number.
151:
152: 0: shl di,$1 / Slide
153: rcl si,$1 / up
154: rcl ax,$1 / one
155: rclb dl,$1 / bit, and
156: loop 0b / loop until done.
157:
158: mov cx,di / Check
159: or cx,si / if
160: or cx,ax / we
161: orb cl,dl / have a zero.
162: jnz 0f / Nope.
163: subb dh,dh / Make all zeros and
164: jmp 2f / return.
165:
166: 0: mov cx,$0x8000 / ch=exp, cl=0
167:
168: 0: orb dl,dl / Normalized ?
169: js 0f / Yes.
170: shl di,$1 / Shift
171: rcl si,$1 / up
172: rcl ax,$1 / one
173: rclb dl,$1 / place.
174: decb ch / Adjust exponant and
175: jmp 0b / loop.
176:
177: 0: and dx,$0x7F / dh=0, dl=no hidden bit
178: shrb SIGN(bp),$1 / carry=sign
179: rcr cx,$1 / Pull into correct place and
180: or dx,cx / pack up double.
181:
182: 2: mov _fpac_+6,dx / Save
183: mov _fpac_+4,ax / into the
184: mov _fpac_+2,si / return
185: mov _fpac_+0,di / location.
186:
187: 1: mov sp,bp / Standard
188: pop bp / C
189: pop di / function
190: pop si / return
191: ret / code.
192:
193: .shrd
194: one: .byte 0x00, 0x00, 0x00, 0x00
195: .byte 0x00, 0x00, 0x80, 0x40
196: @
197:
198:
199: 1.1
200: log
201: @Initial revision
202: @
203: text
204: @d77 1
205: a77 1
206: jmp 1f / Go check the sign.
207: d87 1
208: a87 1
209: jmp 1f / Go check the sign.
210: d155 1
211: a155 29
212: / Final sign checks. The fractional part is always a
213: / positive number. If it is less than zero, add one to it and
214: / subtract one from the integer part.
215:
216: 1: test _fpac_+6,$0x7F80 / Is the return value zero ?
217: jz 0f / Yup.
218: testb _fpac_+7,$0x80 / Is the return value negative ?
219: jz 0f / Nope.
220:
221: mov si,$one / Get address of "1.0"
222: push si / Push for "dladd"
223: call dpush / Push fraction for "dlsub"
224: push si / Push for "dlsub"
225: mov di,ip(bp) / di=pointer to the integer part.
226: push 6(di) / Push
227: push 4(di) / onto the
228: push 2(di) / stack for
229: push 0(di) / "dlsub"
230: call dlsub / Subtract 1 from integer part.
231: add sp,$10 / Pop args.
232: mov si,$_fpac_ / Copy
233: movsw / result
234: movsw / to
235: movsw / the integer
236: movsw / part
237: call dladd / Add one to the fraction
238: add sp,$10 / and clear args.
239:
240: 0: mov sp,bp / Standard
241: @
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.