[unix-history] / fpterp / fp3.s

/ fp3 -- floating simulation

i.addx:
	jsr	pc,setab
	br	1f

i.subx:
	jsr	pc,setab
	neg	bsign
1:
	tst	bsign
	beq	reta
	tst	asign
	beq	retb
	mov	areg+8,r1
	sub	breg+8,r1
	blt	1f
	beq	2f
	cmp	r1,$56.
	bge	reta
	mov	$breg,r0
	br	4f
1:
	neg	r1
	cmp	r1,$56.
	bge	retb
	mov	$areg,r0
4:
	mov	r1,-(sp)
	mov	(r0)+,r1
	mov	(r0)+,r2
	mov	(r0)+,r3
	mov	(r0)+,r4
	add	(sp),(r0)
1:
	clc
	ror	r1
	ror	r2
	ror	r3
	ror	r4
	dec	(sp)
	bgt	1b
	mov	r4,-(r0)
	mov	r3,-(r0)
	mov	r2,-(r0)
	mov	r1,-(r0)
	tst	(sp)+
2:
	mov	$areg+8,r1
	mov	$breg+8,r2
	mov	$4,r0
	cmp	asign,bsign
	bne	4f
	clc
1:
	adc	-(r1)
	bcs	3f
	add	-(r2),(r1)
2:
	dec	r0
	bne	1b
	br	5f
3:
	add	-(r2),(r1)
	sec
	br	2b
	br	5f
4:
	clc
1:
	sbc	-(r1)
	bcs	3f
	sub	-(r2),(r1)
2:
	dec	r0
	bne	1b
	br	5f
3:
	sub	-(r2),(r1)
	sec
	br	2b

saret:
	mov	$areg,r1
5:
	tst	(r1)
	bge	3f
	mov	$areg+8,r1
	mov	$4,r0
	clc
1:
	adc	-(r1)
	bcs	2f
	neg	(r1)
2:
	dec	r0
	bne	1b
	neg	-(r1)
3:
	jsr	pc,norm
	br	reta

retb:
	mov	$bsign,r1
	mov	$asign,r2
	mov	$6,r0
1:
	mov	(r1)+,(r2)+
	dec	r0
	bne	1b

reta:
	mov	r5,r2
	mov	$asign,r0
	tst	(r0)
	beq	unflo
	mov	aexp,r1
	cmp	r1,$177
	bgt	ovflo
	cmp	r1,$-177
	blt	unflo
	add	$200,r1
	swab	r1
	clc
	ror	r1
	tst	(r0)+
	bge	1f
	bis	$100000,r1
1:
	bic	$!177,(r0)
	bis	(r0)+,r1
	mov	r1,(r2)+
	mov	(r0)+,(r2)+
	bit	$m.ext,fpsr
	beq	1f
	mov	(r0)+,(r2)+
	mov	(r0)+,(r2)+
1:
	rts	pc

unflo:
	clr	(r2)+
	clr	(r2)+
	bit	$m.ext,fpsr
	beq	1f
	clr	(r2)+
	clr	(r2)+
1:
	rts	pc

ovflo:
	bis	$2,fpsr			/ set v-bit (overflow)
	jmp	ret

i.mulx:
	jsr	pc,i.mul
	br	saret

i.modx:
	jsr	pc,i.mul
	jsr	pc,norm
	mov	$asign,r0
	mov	$bsign,r1
	mov	$6,r2
1:
	mov	(r0)+,(r1)+
	dec	r2
	bne	1b
	clr	r0		/ count
	mov	$200,r1		/ bit
	clr	r2		/ reg offset
1:
	cmp	r0,aexp
	bge	2f		/ in fraction
	bic	r1,areg(r2)
	br	3f
2:
	bic	r1,breg(r2)
3:
	inc	r0
	clc
	ror	r1
	bne	1b
	mov	$100000,r1
	add	$2,r2
	cmp	r2,$8
	blt	1b
	jsr	pc,norm
	jsr	pc,reta
	cmp	r5,$ac1
	beq	1f
	cmp	r5,$ac3
	beq	1f
	bit	$200,breg
	bne	2f
	clr	bsign
2:
	add	$8,r5
	jsr	pc,retb
	sub	$8,r5
1:
	rts	pc

i.divx:
	jsr	pc,setab
	tst	bsign
	beq	ovflo
	sub	bexp,aexp
	jsr	pc,xorsign
	mov	r5,-(sp)
	mov	$areg,r0
	mov	(r0),r1
	clr	(r0)+
	mov	(r0),r2
	clr	(r0)+
	mov	(r0),r3
	clr	(r0)+
	mov	(r0),r4
	clr	(r0)+
	mov	$areg,r5
	mov	$400,-(sp)
1:
	mov	$breg,r0
	cmp	(r0)+,r1
	blt	2f
	bgt	3f
	cmp	(r0)+,r2
	blo	2f
	bhi	3f
	cmp	(r0)+,r3
	blo	2f
	bhi	3f
	cmp	(r0)+,r4
	bhi	3f
2:
	mov	$breg+10,r0
	sub	-(r0),r4
	sbc	r3
	sbc	r2
	sbc	r1
	sub	-(r0),r3
	sbc	r2
	sbc	r1
	sub	-(r0),r2
	sbc	r1
	sub	-(r0),r1
	bis	(sp),(r5)
3:
	asl	r4
	rol	r3
	rol	r2
	rol	r1
	clc
	ror	(sp)
	bne	1b
	mov	$100000,(sp)
	add	$2,r5
	cmp	r5,$areg+8
	blo	1b
	tst	(sp)+
	mov	(sp)+,r5
	jmp	saret


i.mul:
	jsr	pc,setab
	add	bexp,aexp
	dec	aexp
	jsr	pc,xorsign
	mov	r5,-(sp)
	mov	$breg+4,r5
	bit	$m.ext,fpsr
	bne	3f
1:
	clr	r0
	clr	r1
	clr	r2
	clr	r3
	clr	r4
1:
	asl	r0
	bne	2f
	inc	r0
	tst	-(r5)
2:
	cmp	r0,$400
	bne	2f
	cmp	r5,$breg
	bhi	2f
	mov	$areg,r0
	mov	r1,(r0)+
	mov	r2,(r0)+
	mov	r3,(r0)+
	mov	r4,(r0)+
	mov	(sp)+,r5
	rts	pc
2:
	clc
	ror	r1
	ror	r2
	ror	r3
	ror	r4
	bit	r0,(r5)
	beq	1b
	mov	r0,-(sp)
	mov	$areg,r0
	add	(r0)+,r1
	clr	-(sp)
	add	(r0)+,r2
	adc	(sp)
	clr	-(sp)
	add	(r0)+,r3
	adc	(sp)
	add	(r0)+,r4
	adc	r3
	adc	(sp)
	add	(sp)+,r2
	adc	(sp)
	add	(sp)+,r1
	mov	(sp)+,r0
	br	1b

3:
	mov	$bins,r5
	mov	areg,r1
	mov	areg+2,r2
	mov	areg+4,r3
	mov	areg+6,r4
	mov	r1,(r5)+
	mov	r2,(r5)+
	mov	r3,(r5)+
	mov	r4,(r5)+
	clc
	asl	r4
	rol	r3
	rol	r2
	rol	r1
	mov	r1,(r5)+
	mov	r2,(r5)+
	mov	r3,(r5)+
	mov	r4,(r5)+
	mov	$areg+10,r0
	jsr	pc,addr
	mov	r1,(r5)+
	mov	r2,(r5)+
	mov	r3,(r5)+
	mov	r4,(r5)+
	clr	r1
	clr	r2
	clr	r3
	clr	r4
	mov	$breg+6,r5
	mov	$10,-(sp)
4:
	mov	(r5),r0
	ror	(r5)
	ror	(r5)
	clc
	ror	r1
	ror	r2
	ror	r3
	ror	r4
	clc
	ror	r1
	ror	r2
	ror	r3
	ror	r4
	bic	$177774,r0
	beq	1f
	ash	$3,r0
	add	$bins,r0
	jsr	pc,addr
1:
	dec	(sp)
	bne	4b
	cmp	r5,$breg+2
	beq	1f
	mov	$10,(sp)
	br	2f
1:
	mov	$4,(sp)
2:
	tst	-(r5)
	cmp	r5,$breg
	bhis	4b
	tst	(sp)+
	clc
	ror	r1
	ror	r2
	ror	r3
	ror	r4
	mov	$areg,r0
	mov	r1,(r0)+
	mov	r2,(r0)+
	mov	r3,(r0)+
	mov	r4,(r0)+
	mov	(sp)+,r5
	rts	pc
addr:
	add	-(r0),r4
	adc	r3
	adc	r2
	adc	r1
	add	-(r0),r3
	adc	r2
	adc	r1
	add	-(r0),r2
	adc	r1
	add	-(r0),r1
	rts	pc
xorsign:
	cmp	asign,bsign
	beq	1f
	mov	$-1,asign
	rts	pc
1:
	mov	$1,asign
	rts	pc
Commit	Line	Data
fde98a2d BJ	1	/ fp3 -- floating simulation
	2
	3	i.addx:
	4	jsr pc,setab
	5	br 1f
	6
	7	i.subx:
	8	jsr pc,setab
	9	neg bsign
	10	1:
	11	tst bsign
	12	beq reta
	13	tst asign
	14	beq retb
	15	mov areg+8,r1
	16	sub breg+8,r1
	17	blt 1f
	18	beq 2f
	19	cmp r1,$56.
	20	bge reta
	21	mov $breg,r0
	22	br 4f
	23	1:
	24	neg r1
	25	cmp r1,$56.
	26	bge retb
	27	mov $areg,r0
	28	4:
	29	mov r1,-(sp)
	30	mov (r0)+,r1
	31	mov (r0)+,r2
	32	mov (r0)+,r3
	33	mov (r0)+,r4
	34	add (sp),(r0)
	35	1:
	36	clc
	37	ror r1
	38	ror r2
	39	ror r3
	40	ror r4
	41	dec (sp)
	42	bgt 1b
	43	mov r4,-(r0)
	44	mov r3,-(r0)
	45	mov r2,-(r0)
	46	mov r1,-(r0)
	47	tst (sp)+
	48	2:
	49	mov $areg+8,r1
	50	mov $breg+8,r2
	51	mov $4,r0
	52	cmp asign,bsign
	53	bne 4f
	54	clc
	55	1:
	56	adc -(r1)
	57	bcs 3f
	58	add -(r2),(r1)
	59	2:
	60	dec r0
	61	bne 1b
	62	br 5f
	63	3:
	64	add -(r2),(r1)
65	sec
66	br 2b
67	br 5f
68	4:
69	clc
70	1:
71	sbc -(r1)
72	bcs 3f
73	sub -(r2),(r1)
74	2:
75	dec r0
76	bne 1b
77	br 5f
78	3:
79	sub -(r2),(r1)
80	sec
81	br 2b
82
83	saret:
84	mov $areg,r1
85	5:
86	tst (r1)
87	bge 3f
88	mov $areg+8,r1
89	mov $4,r0
90	clc
91	1:
92	adc -(r1)
93	bcs 2f
94	neg (r1)
95	2:
96	dec r0
97	bne 1b
98	neg -(r1)
99	3:
100	jsr pc,norm
101	br reta
102
103	retb:
104	mov $bsign,r1
105	mov $asign,r2
106	mov $6,r0
107	1:
108	mov (r1)+,(r2)+
109	dec r0
110	bne 1b
111
112	reta:
113	mov r5,r2
114	mov $asign,r0
115	tst (r0)
116	beq unflo
117	mov aexp,r1
118	cmp r1,$177
119	bgt ovflo
120	cmp r1,$-177
121	blt unflo
122	add $200,r1
123	swab r1
124	clc
125	ror r1
126	tst (r0)+
127	bge 1f
128	bis $100000,r1
129	1:
130	bic $!177,(r0)
131	bis (r0)+,r1
132	mov r1,(r2)+
133	mov (r0)+,(r2)+
134	bit $m.ext,fpsr
135	beq 1f
136	mov (r0)+,(r2)+
137	mov (r0)+,(r2)+
138	1:
139	rts pc
140
141	unflo:
142	clr (r2)+
143	clr (r2)+
144	bit $m.ext,fpsr
145	beq 1f
146	clr (r2)+
147	clr (r2)+
148	1:
149	rts pc
150
151	ovflo:
152	bis $2,fpsr / set v-bit (overflow)
153	jmp ret
154
155	i.mulx:
156	jsr pc,i.mul
157	br saret
158
159	i.modx:
160	jsr pc,i.mul
161	jsr pc,norm
162	mov $asign,r0
163	mov $bsign,r1
164	mov $6,r2
165	1:
166	mov (r0)+,(r1)+
167	dec r2
168	bne 1b
169	clr r0 / count
170	mov $200,r1 / bit
171	clr r2 / reg offset
172	1:
173	cmp r0,aexp
174	bge 2f / in fraction
175	bic r1,areg(r2)
176	br 3f
177	2:
178	bic r1,breg(r2)
179	3:
180	inc r0
181	clc
182	ror r1
183	bne 1b
184	mov $100000,r1
185	add $2,r2
186	cmp r2,$8
187	blt 1b
188	jsr pc,norm
189	jsr pc,reta
190	cmp r5,$ac1
191	beq 1f
192	cmp r5,$ac3
193	beq 1f
194	bit $200,breg
195	bne 2f
196	clr bsign
197	2:
198	add $8,r5
199	jsr pc,retb
200	sub $8,r5
201	1:
202	rts pc
203
204	i.divx:
205	jsr pc,setab
206	tst bsign
207	beq ovflo
208	sub bexp,aexp
209	jsr pc,xorsign
210	mov r5,-(sp)
211	mov $areg,r0
212	mov (r0),r1
213	clr (r0)+
214	mov (r0),r2
215	clr (r0)+
216	mov (r0),r3
217	clr (r0)+
218	mov (r0),r4
219	clr (r0)+
220	mov $areg,r5
221	mov $400,-(sp)
222	1:
223	mov $breg,r0
224	cmp (r0)+,r1
225	blt 2f
226	bgt 3f
227	cmp (r0)+,r2
228	blo 2f
229	bhi 3f
230	cmp (r0)+,r3
231	blo 2f
232	bhi 3f
233	cmp (r0)+,r4
234	bhi 3f
235	2:
236	mov $breg+10,r0
237	sub -(r0),r4
238	sbc r3
239	sbc r2
240	sbc r1
241	sub -(r0),r3
242	sbc r2
243	sbc r1
244	sub -(r0),r2
245	sbc r1
246	sub -(r0),r1
247	bis (sp),(r5)
248	3:
249	asl r4
250	rol r3
251	rol r2
252	rol r1
253	clc
254	ror (sp)
255	bne 1b
256	mov $100000,(sp)
257	add $2,r5
258	cmp r5,$areg+8
259	blo 1b
260	tst (sp)+
261	mov (sp)+,r5
262	jmp saret
263
264
265	i.mul:
266	jsr pc,setab
267	add bexp,aexp
268	dec aexp
269	jsr pc,xorsign
270	mov r5,-(sp)
271	mov $breg+4,r5
272	bit $m.ext,fpsr
273	bne 3f
274	1:
275	clr r0
276	clr r1
277	clr r2
278	clr r3
279	clr r4
280	1:
281	asl r0
282	bne 2f
283	inc r0
284	tst -(r5)
285	2:
286	cmp r0,$400
287	bne 2f
288	cmp r5,$breg
289	bhi 2f
290	mov $areg,r0
291	mov r1,(r0)+
292	mov r2,(r0)+
293	mov r3,(r0)+
294	mov r4,(r0)+
295	mov (sp)+,r5
296	rts pc
297	2:
298	clc
299	ror r1
300	ror r2
301	ror r3
302	ror r4
303	bit r0,(r5)
304	beq 1b
305	mov r0,-(sp)
306	mov $areg,r0
307	add (r0)+,r1
308	clr -(sp)
309	add (r0)+,r2
310	adc (sp)
311	clr -(sp)
312	add (r0)+,r3
313	adc (sp)
314	add (r0)+,r4
315	adc r3
316	adc (sp)
317	add (sp)+,r2
318	adc (sp)
319	add (sp)+,r1
320	mov (sp)+,r0
321	br 1b
322
323	3:
324	mov $bins,r5
325	mov areg,r1
326	mov areg+2,r2
327	mov areg+4,r3
328	mov areg+6,r4
329	mov r1,(r5)+
330	mov r2,(r5)+
331	mov r3,(r5)+
332	mov r4,(r5)+
333	clc
334	asl r4
335	rol r3
336	rol r2
337	rol r1
338	mov r1,(r5)+
339	mov r2,(r5)+
340	mov r3,(r5)+
341	mov r4,(r5)+
342	mov $areg+10,r0
343	jsr pc,addr
344	mov r1,(r5)+
345	mov r2,(r5)+
346	mov r3,(r5)+
347	mov r4,(r5)+
348	clr r1
349	clr r2
350	clr r3
351	clr r4
352	mov $breg+6,r5
353	mov $10,-(sp)
354	4:
355	mov (r5),r0
356	ror (r5)
357	ror (r5)
358	clc
359	ror r1
360	ror r2
361	ror r3
362	ror r4
363	clc
364	ror r1
365	ror r2
366	ror r3
367	ror r4
368	bic $177774,r0
369	beq 1f
370	ash $3,r0
371	add $bins,r0
372	jsr pc,addr
373	1:
374	dec (sp)
375	bne 4b
376	cmp r5,$breg+2
377	beq 1f
378	mov $10,(sp)
379	br 2f
380	1:
381	mov $4,(sp)
382	2:
383	tst -(r5)
384	cmp r5,$breg
385	bhis 4b
386	tst (sp)+
387	clc
388	ror r1
389	ror r2
390	ror r3
391	ror r4
392	mov $areg,r0
393	mov r1,(r0)+
394	mov r2,(r0)+
395	mov r3,(r0)+
396	mov r4,(r0)+
397	mov (sp)+,r5
398	rts pc
399	addr:
400	add -(r0),r4
401	adc r3
402	adc r2
403	adc r1
404	add -(r0),r3
405	adc r2
406	adc r1
407	add -(r0),r2
408	adc r1
409	add -(r0),r1
410	rts pc
411	xorsign:
412	cmp asign,bsign
413	beq 1f
414	mov $-1,asign
415	rts pc
416	1:
417	mov $1,asign
418	rts pc
419