|
2824
|
1 /* ************************************************************************ *
|
|
|
2 * pffinit.c - Source for COCO print routines for floats *
|
|
|
3 * ************************************************************************ */
|
|
|
4
|
|
|
5 #include <ctype.h>
|
|
|
6 #include <stdio.h>
|
|
|
7
|
|
|
8 extern double scale ();
|
|
|
9
|
|
|
10 static direct char D0000;
|
|
|
11
|
|
|
12 static char B0000;
|
|
|
13 static char B0001[29];
|
|
|
14
|
|
|
15 /* Initialize G0000 */
|
|
|
16 static char G0000[] = {
|
|
|
17 0x00, 0x00, 0x00, 0x00,
|
|
|
18 0x00, 0x00, 0x00, 0x81,
|
|
|
19 0x4c, 0xcc, 0xcc, 0xcc,
|
|
|
20 0xcc, 0xcc, 0xcd, 0x7d,
|
|
|
21 0x23, 0xd7, 0x0a, 0x3d,
|
|
|
22 0x70, 0xa3, 0xd7, 0x7a,
|
|
|
23 0x03, 0x12, 0x6e, 0x97,
|
|
|
24 0x8d, 0x4f, 0xdf, 0x77,
|
|
|
25 0x51, 0xb7, 0x17, 0x58,
|
|
|
26 0xe2, 0x19, 0x65, 0x73,
|
|
|
27 0x27, 0xc5, 0xac, 0x47,
|
|
|
28 0x1b, 0x47, 0x84, 0x70,
|
|
|
29 0x06, 0x37, 0xbd, 0x05,
|
|
|
30 0xaf, 0x6c, 0x6a, 0x6d,
|
|
|
31 0x56, 0xbf, 0x94, 0xd5,
|
|
|
32 0xe5, 0x7a, 0x43, 0x69,
|
|
|
33 0x2b, 0xcc, 0x77, 0x11,
|
|
|
34 0x84, 0x61, 0xcf, 0x66,
|
|
|
35 0x09, 0x70, 0x5f, 0x41,
|
|
|
36 0x36, 0xb4, 0xa6, 0x63,
|
|
|
37 0x5b, 0xe6, 0xfe, 0xce,
|
|
|
38 0xbd, 0xed, 0xd6, 0x5f,
|
|
|
39 0x2f, 0xeb, 0xff, 0x0b,
|
|
|
40 0xcb, 0x24, 0xab, 0x5c,
|
|
|
41 0x0c, 0xbc, 0xcc, 0x09,
|
|
|
42 0x6f, 0x50, 0x89, 0x59,
|
|
|
43 0x61, 0x2e, 0x13, 0x42,
|
|
|
44 0x4b, 0xb4, 0x0e, 0x55,
|
|
|
45 0x34, 0x24, 0xdc, 0x35,
|
|
|
46 0x09, 0x5c, 0xd8, 0x52,
|
|
|
47 0x10, 0x1d, 0x7c, 0xf7,
|
|
|
48 0x3a, 0xb0, 0xad, 0x4f,
|
|
|
49 0x66, 0x95, 0x94, 0xbe,
|
|
|
50 0xc4, 0x4d, 0xe1, 0x4b,
|
|
|
51 0x38, 0x77, 0xaa, 0x32,
|
|
|
52 0x36, 0xa4, 0xb4, 0x48
|
|
|
53 };
|
|
|
54
|
|
|
55 /* dummy function to include this ROF */
|
|
|
56
|
|
|
57 pffinit ()
|
|
|
58 {
|
|
|
59 return;
|
|
|
60 }
|
|
|
61
|
|
|
62 pffloat (parm1, parm2, parm3, parm4)
|
|
|
63 int parm1;
|
|
|
64 int parm2;
|
|
|
65 double **parm3;
|
|
|
66 int parm4;
|
|
|
67 {
|
|
|
68 int pfv0;
|
|
|
69
|
|
|
70 switch (parm1)
|
|
|
71 {
|
|
|
72 case 'f': /* L000a */
|
|
|
73 pfv0 = 1;
|
|
|
74 break;
|
|
|
75 case 'e': /* L000f */
|
|
|
76 case 'E': /* L000f */
|
|
|
77 pfv0 = -1;
|
|
|
78 break;
|
|
|
79 case 'g': /* L0014 */
|
|
|
80 case 'G': /* L0014 */
|
|
|
81 pfv0 = 0;
|
|
|
82 break;
|
|
|
83 }
|
|
|
84
|
|
|
85 L0064 ((*parm3)++, parm2, pfv0, _chcodes [parm1] & 2);
|
|
|
86 }
|
|
|
87
|
|
|
88 L0064 (parm1, parm2, parm3, parm4, parm5)
|
|
|
89 double *parm1;
|
|
|
90 int parm2;
|
|
|
91 int parm3;
|
|
|
92 int parm4;
|
|
|
93 int parm5;
|
|
|
94 {
|
|
|
95 char *var30;
|
|
|
96 int var28;
|
|
|
97 int var26;
|
|
|
98 int var24;
|
|
|
99 int var22;
|
|
|
100 int var20;
|
|
|
101 int var18;
|
|
|
102 int var16;
|
|
|
103 int var14;
|
|
|
104 int var12;
|
|
|
105 int var10; /* temporarily ? */
|
|
|
106 int var8;
|
|
|
107 double var0;
|
|
|
108
|
|
|
109 register char * regptr;
|
|
|
110
|
|
|
111 var8 = 1;
|
|
|
112 var0 = *parm1;
|
|
|
113 regptr = (char *)(&var0);
|
|
|
114
|
|
|
115 if (regptr[7] == 0) /* else L008f */
|
|
|
116 {
|
|
|
117 var18 = var26 = var24 = 0;
|
|
|
118 goto L0181;
|
|
|
119 }
|
|
|
120
|
|
|
121 var22 = (regptr[7] & 0xff) - 0x80;
|
|
|
122
|
|
|
123 /* L008f */
|
|
|
124 if (var22 < 0) /* else L00a9 */
|
|
|
125 {
|
|
|
126 var22 = -var22;
|
|
|
127 var24 = 1;
|
|
|
128 }
|
|
|
129 else
|
|
|
130 {
|
|
|
131 var24 = 0;
|
|
|
132 }
|
|
|
133
|
|
|
134 var20 = (var22 * 78) >> 8;
|
|
|
135
|
|
|
136 if (var24)
|
|
|
137 {
|
|
|
138 var18 = -var20 + 1;
|
|
|
139 }
|
|
|
140 else
|
|
|
141 {
|
|
|
142 var18 = var20 + 1;
|
|
|
143 }
|
|
|
144
|
|
|
145 if (regptr[0] < 0) /* else L00eb */
|
|
|
146 {
|
|
|
147 regptr[0] &= 0x7f;
|
|
|
148 var26 = 1;
|
|
|
149 }
|
|
|
150 else
|
|
|
151 {
|
|
|
152 var26 = 0;
|
|
|
153 }
|
|
|
154
|
|
|
155 var0 = scale (var0, var20, var24); /* go to L012f */
|
|
|
156
|
|
|
157 while (var0 < 1)
|
|
|
158 {
|
|
|
159 var0 *= 10;
|
|
|
160 --var18;
|
|
|
161 }
|
|
|
162
|
|
|
163 while (var0 >= 10) /* L0169 */
|
|
|
164 {
|
|
|
165 var0 /= 10;
|
|
|
166 ++var18;
|
|
|
167 }
|
|
|
168
|
|
|
169 L0181:
|
|
|
170 var30 = &B0000;
|
|
|
171 *(var30++) = '0';
|
|
|
172
|
|
|
173 if (var26) /* else L01aa */
|
|
|
174 {
|
|
|
175 *(var30++) = '-';
|
|
|
176 }
|
|
|
177
|
|
|
178 if (parm2 > 16) /* else L01aa */
|
|
|
179 {
|
|
|
180 parm2 = 16;
|
|
|
181 }
|
|
|
182 else
|
|
|
183 {
|
|
|
184 if (parm2 < 0)
|
|
|
185 {
|
|
|
186 parm2 = 0;
|
|
|
187 }
|
|
|
188 }
|
|
|
189
|
|
|
190 var10 = 0; /* L01c2 */
|
|
|
191
|
|
|
192 if ( ! parm3) /* else L01e0 */
|
|
|
193 {
|
|
|
194 var10 = 1;
|
|
|
195
|
|
|
196 if (var18 > 5)
|
|
|
197 {
|
|
|
198 goto L01e7;
|
|
|
199 }
|
|
|
200
|
|
|
201 goto L0213;
|
|
|
202 }
|
|
|
203 else
|
|
|
204 {
|
|
|
205 if (parm3 < 0)
|
|
|
206 {
|
|
|
207 L01e7:
|
|
|
208 var16 = 1;
|
|
|
209 var12 = 1;
|
|
|
210
|
|
|
211 if (var0 == 0) /* else L0258 */
|
|
|
212 {
|
|
|
213 var18 = 1;
|
|
|
214 }
|
|
|
215 }
|
|
|
216 else
|
|
|
217 {
|
|
|
218 L0213:
|
|
|
219 var16 = 0;
|
|
|
220
|
|
|
221 if ((var12 = var18) < 0) /* else L0247 */
|
|
|
222 {
|
|
|
223 if ((var12 + parm2) >= 0) /* else L0233 */
|
|
|
224 {
|
|
|
225 parm2 += var12;
|
|
|
226 /* go to L0258 */
|
|
|
227 }
|
|
|
228 else
|
|
|
229 {
|
|
|
230 var12 = -parm2;
|
|
|
231 parm2 = 0;
|
|
|
232 var8 = 0;
|
|
|
233 }
|
|
|
234 }
|
|
|
235 else
|
|
|
236 { /* L0247 */
|
|
|
237 if ((var12 + parm2) > 25)
|
|
|
238 {
|
|
|
239 goto L01e7;
|
|
|
240 }
|
|
|
241 }
|
|
|
242 }
|
|
|
243 }
|
|
|
244
|
|
|
245 /* L0258 */
|
|
|
246 var14 = G0000;
|
|
|
247 L0464 (&var0);
|
|
|
248
|
|
|
249 if (var12 < 0) /* else L029e */
|
|
|
250 {
|
|
|
251 *(var30++) = '0';
|
|
|
252 var28 = var30;
|
|
|
253 *(var30++) = '.';
|
|
|
254
|
|
|
255 while (var12++)
|
|
|
256 {
|
|
|
257 *(var30++) = '0';
|
|
|
258 }
|
|
|
259 /* go to L02f1 */
|
|
|
260 }
|
|
|
261 else
|
|
|
262 { /* L029e */
|
|
|
263 if ( ! var12) /* else L02be */
|
|
|
264 {
|
|
|
265 *(var30++) = '0';
|
|
|
266 }
|
|
|
267
|
|
|
268 while (var12--)
|
|
|
269 {
|
|
|
270 *(var30++) = L049c (&var0, &var14);
|
|
|
271 }
|
|
|
272
|
|
|
273 var28 = var30;
|
|
|
274
|
|
|
275 if (parm2)
|
|
|
276 {
|
|
|
277 *(var30++) = '.';
|
|
|
278 }
|
|
|
279 }
|
|
|
280
|
|
|
281 while (((parm2--) > 0)) /* @ L02f1 */
|
|
|
282 {
|
|
|
283 *(var30++) = L049c (&var0, &var14);
|
|
|
284 }
|
|
|
285
|
|
|
286 if (var8) /* else L037b */
|
|
|
287 {
|
|
|
288 int loc02;
|
|
|
289 char *loc00;
|
|
|
290
|
|
|
291 *(loc00 = var30) = L049c (&var0, &var14);
|
|
|
292 loc02 = 5;
|
|
|
293
|
|
|
294 for (;;)
|
|
|
295 {
|
|
|
296 switch (*loc00)
|
|
|
297 {
|
|
|
298 case '.': /* L032c */
|
|
|
299 --loc00;
|
|
|
300 break;
|
|
|
301 case '-': /* L0335 */
|
|
|
302 loc00[-1] = '-';
|
|
|
303 *loc00 = '0';
|
|
|
304 break;
|
|
|
305 }
|
|
|
306
|
|
|
307 /* L034d */
|
|
|
308 /**loc00 += loc02;*/
|
|
|
309
|
|
|
310 if ( (loc02 = ((*loc00 += loc02) > '9'))) /* else L0379 */
|
|
|
311 {
|
|
|
312 *loc00 -= 10;
|
|
|
313 -- loc00;
|
|
|
314 continue;
|
|
|
315 }
|
|
|
316 else
|
|
|
317 {
|
|
|
318 break;
|
|
|
319 }
|
|
|
320
|
|
|
321 }
|
|
|
322 }
|
|
|
323
|
|
|
324 /* L037b */
|
|
|
325 if (var16) /* else L03f2 */
|
|
|
326 {
|
|
|
327 *(var30++) = (parm4 ? 'E' : 'e');
|
|
|
328
|
|
|
329 if ((--var18 < 0)) /* else L03b3 */
|
|
|
330 {
|
|
|
331 var18 = -var18;
|
|
|
332 *(var30++) = '-';
|
|
|
333 }
|
|
|
334 else
|
|
|
335 {
|
|
|
336 *(var30++) = '+';
|
|
|
337 }
|
|
|
338
|
|
|
339 *(var30++) = (var18/10) + '0';
|
|
|
340 *(var30++) = (var18 % 10) + '0';
|
|
|
341 /* go to L0422 */
|
|
|
342 }
|
|
|
343 else
|
|
|
344 { /* L03f2 */
|
|
|
345 if ((var10) && (var30 != var28)) /* else L0422 */
|
|
|
346 {
|
|
|
347 while ((--var30) != var28)
|
|
|
348 {
|
|
|
349 if ((*var30 != '0'))
|
|
|
350 {
|
|
|
351 ++var30;
|
|
|
352 break;
|
|
|
353 }
|
|
|
354 }
|
|
|
355 }
|
|
|
356 }
|
|
|
357
|
|
|
358 *var30 = '\0'; /* L0422 */
|
|
|
359
|
|
|
360 if ((&B0001[sizeof (B0001)]) <= var30)
|
|
|
361 {
|
|
|
362 fprintf (stderr, "pffinit buffer overflow\n");
|
|
|
363 exit (1);
|
|
|
364 }
|
|
|
365
|
|
|
366 return (B0000 == '0' ? B0001 : &B0000);
|
|
|
367 }
|
|
|
368
|
|
|
369 /* The following routine is strictly asm for the COCO
|
|
|
370 */
|
|
|
371
|
|
|
372 #ifdef COCO
|
|
|
373 #asm
|
|
|
374 L0464 pshs u
|
|
|
375 ldx 4,s
|
|
|
376 lda 7,x
|
|
|
377 suba #$80
|
|
|
378 bcs L0496
|
|
|
379 ldb ,x
|
|
|
380 orb #$80
|
|
|
381 stb ,x
|
|
|
382 clr 7,x
|
|
|
383 suba #4
|
|
|
384 beq L048d
|
|
|
385 L047a lsr ,x
|
|
|
386 ror 1,x
|
|
|
387 ror 2,x
|
|
|
388 ror 3,x
|
|
|
389 ror 4,x
|
|
|
390 ror 5,x
|
|
|
391 ror 6,x
|
|
|
392 ror 7,x
|
|
|
393 inca
|
|
|
394 bne L047a
|
|
|
395 L048d lda #8
|
|
|
396 L048f deca
|
|
|
397 bmi L0496
|
|
|
398 ldb a,x
|
|
|
399 beq L048f
|
|
|
400 L0496 sta D0000
|
|
|
401 clra
|
|
|
402 clrb
|
|
|
403 puls u,pc
|
|
|
404 L049c ldx 2,s
|
|
|
405 clra
|
|
|
406 ldb ,x
|
|
|
407 lsrb
|
|
|
408 lsrb
|
|
|
409 lsrb
|
|
|
410 lsrb
|
|
|
411 addb #'0
|
|
|
412 pshs d,u
|
|
|
413 ldb ,x
|
|
|
414 andb #$0f
|
|
|
415 stb ,x
|
|
|
416 bsr L04dd
|
|
|
417 lda D0000
|
|
|
418 bmi L04db
|
|
|
419 L04b5 ldb a,x
|
|
|
420 bne L04bc
|
|
|
421 deca
|
|
|
422 bpl L04b5
|
|
|
423 L04bc sta D0000
|
|
|
424 bmi L04db
|
|
|
425 leas -8,s
|
|
|
426 L04c2 ldb a,x
|
|
|
427 stb a,s
|
|
|
428 deca
|
|
|
429 bpl L04c2
|
|
|
430 bsr L04dd
|
|
|
431 bsr L04dd
|
|
|
432 lda D0000
|
|
|
433 clrb
|
|
|
434 L04d0 ldb a,x
|
|
|
435 adcb a,s
|
|
|
436 stb a,x
|
|
|
437 deca
|
|
|
438 bpl L04d0
|
|
|
439 leas 8,s
|
|
|
440 L04db puls d,u,pc
|
|
|
441 L04dd lda D0000
|
|
|
442 bmi L04ea
|
|
|
443 asl a,x
|
|
|
444 bra L04e7
|
|
|
445 L04e5 rol a,x
|
|
|
446 L04e7 deca
|
|
|
447 bpl L04e5
|
|
|
448 L04ea rts
|
|
|
449 #endasm
|
|
|
450 #endif
|
