Context Navigation

source: git/MP/MP/MP_Put.c @ c729f2

fieker-DuValspielwiese

Last change on this file since c729f2 was 4439165, checked in by Hans Schönemann <hannes@…>, 15 years ago
*hannes: gcc 4.3 git-svn-id: file:///usr/local/Singular/svn/trunk@11873 2c84dea3-7e68-4137-9b89-c4e89433aadc
Property mode set to `100644`
File size: 44.0 KB

Line
1	/**************************************************************************
2	*
3	* MP version 1.1.2: Multi Protocol
4	* Kent State University, Kent, OH
5	* Authors: S. Gray, N. Kajler, P. Wang
6	* (C) 1993, 1994, 1995, 1996, 1997 All Rights Reserved
7	*
8	* NOTICE
9	*
10	* Permission to use, copy, modify, and distribute this software and
11	* its documentation for non-commercial purposes and without fee is
12	* hereby granted provided that the above copyright notice appear in all
13	* copies and that both the copyright notice and this permission notice
14	* appear in supporting documentation.
15	*
16	* Neither Kent State University nor the Authors make any representations
17	* about the suitability of this software for any purpose. The MP Library
18	* is distributed in the hope that it will be useful, but is provided "as
19	* is" and without any warranty of any kind and without even the implied
20	* warranty of merchantability or fitness for a particular purpose.
21	*
22	* IMPORTANT ADDITION: as of September 2006, MP is also licenced under GPL
23	*
24	* IMPLEMENTATION FILE: MP_Put.c
25	*
26	* All the put routines.
27	*
28	* Change Log:
29	* May 30, 1995 SG - added MP_PutSint8Packet()
30	* June 5, 1995 SG - added MP_PutUint8Packet()
31	* - changed IMP_PutOperator() to only output
32	* the operator, as a string. That is, it no
33	* longer also sends a num_child field, since that
34	* job is now done by imp_put_node_header().
35	* IMP_PutMpOperator() is handled in MP_Put.h
36	* July 6, 1995 SG - added MP_PutLatin/GreekCommonIdentifierPacket()
37	* - added MP_PutCommonOperatorPacket()
38	* - added MP_PutCommonConstantPacket()
39	* July 7, 1995 SG - added MP_PutBooleanPacket()
40	* - changed MP_CantPut<type>Packet error values to
41	* MP_CantPut<type>
42	* - cleaned up some comments/unneeded code.
43	* 10/18/95 OB - changed PutApInt routines such that
44	* only size field is communicated, not the alloc field
45	* 12/1/95 SG - fixed bug in routines which have to pad a value with
46	* NULL bytes to get the right alignment
47	* 2/28/96 SG - Changed the NodeFlags fields to DictTag to reflect
48	* the change in how we identify dictionaries and do
49	* semantics. Also changed IMP_PutNodeHeader() so
50	* that it now takes arguments for all of the fields
51	* in a packet header. BUT - see comment with
52	* IMP_PutNodeHeader() regarding dictionary tags.
53	* 4/29/96 sgray - Made the PutApInt() routines more generic. They
54	* now take a pointer to void. So the sender can
55	* send in its "native" bignum format (provided we
56	* have the supporting routines in place). New formats
57	* can be added as needed without affecting the design.
58	* 3/11/97 sgray - Fixed logging of ApInts as recommended by obachman.
59	* Also cleaned up logging in the PutString and ApReal
60	* functions.
61	* - added Olaf's routines to put the MetaOperator and
62	* CommonMeta types.
63	**************************************************************************
64	*
65	* xdr_float.c, Generic XDR routine implementation.
66	*
67	* Copyright (C) 1984, Sun Microsystems, Inc.
68	*
69	* These are the "floating point" xdr routines used to (de)serialize
70	* most common data items. See xdr.h for more info on the interface to
71	* xdr.
72	*
73	* The MP Library is distributed in the hope that it will be useful,
74	* but without any warranty of any kind and without even the implied
75	* warranty of merchantability or fitness for a particular purpose.
76	*
77	**************************************************************************/
78
79
80	#include "MP.h"
81	#include <string.h>
82
83
84	static char filler[4]={0, 0, 0, 0};
85
86	/*
87	* these two defined in MP_Util.c
88	*/
89	EXTERN char fix_log_msg[];
90	EXTERN char AnnotFlagsStr[];
91
92
93	#ifdef __STDC__
94	MP_Status_t MP_PutAnnotationPacket(MP_Link_pt link,
95	MP_DictTag_t dtag,
96	MP_AnnotType_t atype,
97	MP_AnnotFlags_t flags)
98	#else
99	MP_Status_t MP_PutAnnotationPacket(link, dtag, atype, flags)
100	MP_Link_pt link;
101	MP_DictTag_t dtag;
102	MP_AnnotType_t atype;
103	MP_AnnotFlags_t flags;
104	#endif
105	{
106	MP_AnnotHeader_t annot = 0;
107
108	MP_SetAnnotTypeField(annot, atype);
109	MP_SetAnnotDictTagField(annot, dtag);
110	MP_SetAnnotFlagsField(annot, flags);
111
112	if (!IMP_PutLong(link, (long*)&annot))
113	return MP_SetError(link, MP_CantPutAnnotationPacket);
114
115	#ifndef NO_LOGGING
116	if (link->logmask & MP_LOG_WRITE_EVENTS) {
117	annot_flags_to_str(flags);
118	/* The following is acceptable only for now. Eventually I
119	must clearly identify the MP dictionary range. */
120	/* 3/28/97 - sgray - annotations are spread out through a variety
121	of header files, so giving a string version of the annotation
122	is not practical at this time. Maybe have they are stable we
123	can create function to do a (dtag, atype) mapping to a string. */
124	/* if (dtag == 0)
125	sprintf(fix_log_msg, "%-12s flags: %s dict: %lu ",
126	annotations[atype], AnnotFlagsStr, dtag);
127	else
128	*/
129	sprintf(fix_log_msg, "AnnotPkt dict: %lu atype: %u flags: %s",
130	dtag, atype, AnnotFlagsStr);
131	MP_LogEvent(link, MP_WRITE_EVENT, fix_log_msg);
132	}
133	#endif
134
135	return MP_ClearError(link);
136	}
137
138	/* this is a private version of the IMP_PutNodeHeader() routine
139	* IMPORTANT: At this time we have not determined how dictionary
140	* tags beyond 255 should be allocated. The code below make NO
141	* check to see if dtag is 127 or 255 (the indicators telling us
142	* the read in another 4 bytes with the true tag. Once we know
143	* how those tags will be disbursed, we can do the proper check
144	* here. To be clear. The problem is that if the incoming dtag
145	* is > 255, we can't yet identify it as MP-extended or user-extended,
146	* so can't know whether to use 127 or 255. It might be a good
147	* idea to combine these into a single "extended tag" and just
148	* divy up the 4 byte tags as well. This has to be fixed for
149	* imp_get_node_header() as well.
150	*/
151	#ifdef __STDC__
152	static MP_Status_t imp_put_node_header(MP_Link_pt link,
153	MP_NodeType_t ntype,
154	MP_DictTag_t dtag,
155	MP_Common_t cval,
156	MP_NumAnnot_t num_annots,
157	MP_NumChild_t num_child)
158	#else
159	static MP_Status_t imp_put_node_header(link, ntype, dtag, cval, num_annots,
160	num_child)
161	MP_Link_pt link;
162	MP_NodeType_t ntype;
163	MP_DictTag_t dtag;
164	MP_Common_t cval;
165	MP_NumAnnot_t num_annots;
166	MP_NumChild_t num_child;
167	#endif
168	{
169	MP_NodeHeader_t hdr = 0;
170
171	#ifdef MP_DEBUG
172	fprintf(stderr,
173	"imp_put_node_header: entering - ntype = %d, num_child = %d\n",
174	ntype, num_child);
175	#endif
176
177	if (link == NULL)
178	return MP_SetError(link, MP_NullLink);
179
180	MP_SetNodeTypeField(hdr, ntype);
181	MP_SetNodeCommonValueField(hdr, cval);
182	MP_SetNodeDictTagField(hdr, dtag); /* see important note above */
183
184	if (num_child != 0)
185	if (num_child < MP_ExtraFieldIndicator)
186	MP_SetNodeNumChildField(hdr, num_child);
187	else
188	MP_SetNodeExtraChildField(hdr);
189
190	if (num_annots != 0)
191	if (num_annots < MP_ExtraFieldIndicator)
192	MP_SetNodeNumAnnotsField(hdr, num_annots);
193	else
194	MP_SetNodeExtraAnnotsField(hdr);
195
196	if (!IMP_PutLong(link, (long *)&hdr))
197	return MP_SetError(link, MP_CantPutNodeHeader);
198
199	/* see if there is an extra number of children field to send */
200	if (num_child >= MP_ExtraFieldIndicator
201	&& !IMP_PutLong(link, (long*)&num_child))
202	return MP_SetError(link, MP_CantPutNodeHeader);
203
204	/* see if there is an extra number of annotations field to send */
205	if (num_annots >= MP_ExtraFieldIndicator
206	&& !IMP_PutLong(link, (long*)&num_annots))
207	return MP_SetError(link, MP_CantPutNodeHeader);
208
209	#ifdef MP_DEBUG
210	fprintf(stderr,
211	"imp_put_node_header: exiting - hdr = 0x%X, \ttype = %d\tnum_child"
212	" = %d\tnum_annot = %d\n",
213	hdr, ntype, num_child, num_annots);
214	#endif
215
216	return MP_ClearError(link);
217	}
218
219
220
221	/*
222	* This is what the programmer sees through the API. But we just call the
223	* private version above, then do the logging (if enabled).
224	*/
225	#ifdef __STDC__
226	MP_Status_t IMP_PutNodeHeader(MP_Link_pt link,
227	MP_NodeType_t ntype,
228	MP_DictTag_t dtag,
229	MP_Common_t cval,
230	MP_NumAnnot_t num_annots,
231	MP_NumChild_t num_child)
232	#else
233	MP_Status_t IMP_PutNodeHeader(link, ntype, dtag, cval, num_annots, num_child)
234	MP_Link_pt link;
235	MP_NodeType_t ntype;
236	MP_DictTag_t dtag;
237	MP_Common_t cval;
238	MP_NumAnnot_t num_annots;
239	MP_NumChild_t num_child;
240	#endif
241	{
242	imp_put_node_header(link, ntype, dtag, cval, num_annots, num_child);
243
244	#ifndef NO_LOGGING
245	if (link->logmask & MP_LOG_WRITE_EVENTS) {
246	sprintf(fix_log_msg,
247	"%-12s %-12s annots: %lu args: %lu dict: %lu cval: %u",
248	"NodePktHdr", IMP_TypeToString(ntype), num_annots,
249	num_child, dtag, cval);
250	MP_LogEvent(link, MP_WRITE_EVENT, fix_log_msg);
251	}
252	#endif
253
254	return MP_ClearError(link);
255	}
256
257
258
259
260	#ifdef __STDC__
261	MP_Status_t IMP_PutSint32(MP_Link_pt link,
262	MP_Sint32_t n)
263	#else
264	MP_Status_t IMP_PutSint32(link, n)
265	MP_Link_pt link;
266	MP_Sint32_t n;
267	#endif
268	{
269	if (!IMP_PutLong(link, &n))
270	return MP_SetError(link, MP_CantPutDataPacket);
271
272	#ifndef NO_LOGGING
273	if (link->logmask & MP_LOG_WRITE_EVENTS)
274	log_fixnum(link, MP_WRITE_EVENT, "Sint32_DP", MP_Sint32Type, 0, &n);
275	#endif
276
277	return MP_ClearError(link);
278
279	}
280
281
282
283	#ifdef __STDC__
284	MP_Status_t IMP_PutUint32(MP_Link_pt link,
285	MP_Uint32_t n)
286	#else
287	MP_Status_t IMP_PutUint32(link, n)
288	MP_Link_pt link;
289	MP_Uint32_t n;
290	#endif
291	{
292	if (!IMP_PutLong(link, (long*)&n))
293	return MP_SetError(link, MP_CantPutDataPacket);
294
295	#ifndef NO_LOGGING
296	if (link->logmask & MP_LOG_WRITE_EVENTS)
297	log_fixnum(link, MP_WRITE_EVENT, "Uint32_DP", MP_Uint32Type, 0, &n);
298	#endif
299
300	return MP_ClearError(link);
301	}
302
303
304
305
306	#ifdef __STDC__
307	MP_Status_t IMP_PutRaw(MP_Link_pt link,
308	char *rawdata,
309	MP_Uint32_t len)
310	#else
311	MP_Status_t IMP_PutRaw(link, rawdata, len)
312	MP_Link_pt link;
313	char *rawdata;
314	MP_Uint32_t len;
315	#endif
316	{
317	unsigned long extra;
318
319	extra = len % MP_BytesPerMPUnit;
320	extra = MP_BytesPerMPUnit - extra;
321
322	if (!(IMP_PutLong(link, (long*)&len) && IMP_PutBytes(link, rawdata, len)))
323	return MP_SetError(link, MP_CantPutDataPacket);
324
325	if (extra != MP_BytesPerMPUnit /* have to pad with extra null bytes */
326	&& !IMP_PutBytes(link, filler, extra))
327	return MP_SetError(link, MP_CantPutDataPacket);
328
329	#ifndef NO_LOGGING
330	if (link->logmask & MP_LOG_WRITE_EVENTS) {
331	sprintf(fix_log_msg, "%-12s #bytes: %lu (data not shown)",
332	"Raw_DP", len);
333	MP_LogEvent(link, MP_WRITE_EVENT, fix_log_msg);
334	}
335	#endif
336
337	return MP_ClearError(link);
338	}
339
340
341
342
343	#ifdef __STDC__
344	MP_Status_t IMP_PutString(MP_Link_pt link,
345	char *s)
346	#else
347	MP_Status_t IMP_PutString(link, s)
348	MP_Link_pt link;
349	char *s;
350	#endif
351	{
352	short extra;
353	unsigned long n;
354
355	n = strlen(s);
356	extra = n % MP_BytesPerMPUnit;
357	extra = MP_BytesPerMPUnit - extra;
358
359	if (! (IMP_PutLong(link, (long*)&n) && IMP_PutBytes(link, s, n)))
360	return MP_SetError(link, MP_CantPutDataPacket);
361
362	if (extra != MP_BytesPerMPUnit /* have to pad with extra null byres */
363	&& !IMP_PutBytes(link, filler, extra))
364	return MP_SetError(link, MP_CantPutDataPacket);
365
366	#ifndef NO_LOGGING
367	if (link->logmask & MP_LOG_WRITE_EVENTS) {
368	int len = strlen(s) + 36;
369	char *tmp_msg = IMP_MemAllocFnc(len);
370	sprintf(tmp_msg, "%-12s value: %s", "String_DP", s);
371	MP_LogEvent(link, MP_WRITE_EVENT, tmp_msg);
372	IMP_MemFreeFnc(tmp_msg, len);
373	}
374	#endif
375
376	return MP_ClearError(link);
377	}
378
379
380
381
382	#ifdef __STDC__
383	MP_Status_t common_put_string(MP_Link_pt link, const char *s)
384	#else
385	MP_Status_t common_put_string(link, s)
386	MP_Link_pt link;
387	const char *s;
388	#endif
389	{
390	short extra;
391	unsigned long n;
392
393	n = strlen(s);
394	extra = n % MP_BytesPerMPUnit;
395	extra = MP_BytesPerMPUnit - extra;
396
397	if (! (IMP_PutLong(link, (long*)&n) && IMP_PutBytes(link, s, n)))
398	return MP_SetError(link, MP_CantPutDataPacket);
399
400	if (extra != MP_BytesPerMPUnit /* have to pad with extra null byres */
401	&& !IMP_PutBytes(link, filler, extra))
402	return MP_SetError(link, MP_CantPutDataPacket);
403
404	return MP_ClearError(link);
405	}
406
407
408
409	#ifdef __STDC__
410	MP_Status_t MP_PutConstantPacket(MP_Link_pt link,
411	MP_DictTag_t dtag,
412	char *cnst,
413	MP_NumAnnot_t num_annots)
414	#else
415	MP_Status_t MP_PutConstantPacket(link, dtag, cnst, num_annots)
416	MP_Link_pt link;
417	MP_DictTag_t dtag;
418	char *cnst;
419	MP_NumAnnot_t num_annots;
420	#endif
421	{
422	if (! (imp_put_node_header(link, MP_ConstantType, dtag, 0, num_annots, 0)
423	&& common_put_string(link, cnst)))
424	return MP_SetError(link, MP_CantPutNodePacket);
425
426	#ifndef NO_LOGGING
427	if (link->logmask & MP_LOG_WRITE_EVENTS) {
428	sprintf(fix_log_msg, "%-12s annots: %lu dict: %lu value: %s",
429	"Constant_NP", num_annots, dtag, cnst);
430	MP_LogEvent(link, MP_WRITE_EVENT, fix_log_msg);
431	}
432	#endif
433
434	return MP_ClearError(link);
435	}
436
437
438	#ifdef __STDC__
439	MP_Status_t MP_PutCommonLatinIdentifierPacket(MP_Link_pt link,
440	MP_DictTag_t dtag,
441	MP_Common_t id,
442	MP_NumAnnot_t num_annots)
443	#else
444	MP_Status_t MP_PutCommonLatinIdentifierPacket(link, dtag, id, num_annots)
445	MP_Link_pt link;
446	MP_DictTag_t dtag;
447	MP_Common_t id;
448	MP_NumAnnot_t num_annots;
449	#endif
450	{
451	if (!imp_put_node_header(link, MP_CommonLatinIdentifierType, dtag, id,
452	num_annots, 0))
453	return MP_SetError(link, MP_CantPutNodePacket);
454
455	#ifndef NO_LOGGING
456	if (link->logmask & MP_LOG_WRITE_EVENTS)
457	log_dicttype(link, MP_WRITE_EVENT, "Latin Id_NP",
458	MP_CommonLatinIdentifierType, num_annots, dtag, &id, 0);
459	#endif
460
461	return MP_ClearError(link);
462	}
463
464
465
466	#ifdef __STDC__
467	MP_Status_t MP_PutCommonGreekIdentifierPacket(MP_Link_pt link,
468	MP_DictTag_t dtag,
469	MP_Common_t id,
470	MP_NumAnnot_t num_annots)
471	#else
472	MP_Status_t MP_PutCommonGreekIdentifierPacket(link, dtag, id, num_annots)
473	MP_Link_pt link;
474	MP_DictTag_t dtag;
475	MP_Common_t id;
476	MP_NumAnnot_t num_annots;
477	#endif
478	{
479	if (!imp_put_node_header(link, MP_CommonGreekIdentifierType, dtag, id,
480	num_annots, 0))
481	return MP_SetError(link, MP_CantPutNodePacket);
482
483	#ifndef NO_LOGGING
484	if (link->logmask & MP_LOG_WRITE_EVENTS)
485	log_dicttype(link, MP_WRITE_EVENT, "Greek Id_NP",
486	MP_CommonGreekIdentifierType, num_annots, dtag, &id, 0);
487	#endif
488
489	return MP_ClearError(link);
490	}
491
492
493	#ifdef __STDC__
494	MP_Status_t MP_PutIdentifierPacket(MP_Link_pt link,
495	MP_DictTag_t dtag,
496	const char *id,
497	MP_NumAnnot_t num_annots)
498	#else
499	MP_Status_t MP_PutIdentifierPacket(link, dtag, id, num_annots)
500	MP_Link_pt link;
501	MP_DictTag_t dtag;
502	char *id;
503	MP_NumAnnot_t num_annots;
504	#endif
505	{
506	if (!(imp_put_node_header(link, MP_IdentifierType, dtag, *id, num_annots, 0)
507	&& common_put_string(link, id)))
508	return MP_SetError(link, MP_CantPutNodePacket);
509
510	#ifndef NO_LOGGING
511	if (link->logmask & MP_LOG_WRITE_EVENTS) {
512	sprintf(fix_log_msg, "%-12s annots: %lu dict: %lu value: %s",
513	"Ident_NP", num_annots, dtag, id);
514	MP_LogEvent(link, MP_WRITE_EVENT, fix_log_msg);
515	}
516	#endif
517
518	return MP_ClearError(link);
519	}
520
521
522
523	#ifdef __STDC__
524	MP_Status_t IMP_PutStringBasedTypePacket(MP_Link_pt link,
525	char *s,
526	MP_NumAnnot_t num_annots,
527	MP_NodeType_t ntype)
528	#else
529	MP_Status_t IMP_PutStringBasedTypePacket(link, s, num_annots, ntype)
530	MP_Link_pt link;
531	char *s;
532	MP_NumAnnot_t num_annots;
533	MP_NodeType_t ntype;
534	#endif
535	{
536	/*
537	* generic put routine for all string-based types
538	*/
539
540	#ifndef NO_LOGGING
541	char thetype = NULL; / for logging only */
542
543	if (link->logmask & MP_LOG_WRITE_EVENTS) {
544	if (ntype == MP_StringType)
545	thetype = "String_NP";
546	else if (ntype == MP_MetaType)
547	thetype = "Meta_NP";
548
549	sprintf(fix_log_msg, "%-12s %4lu %-24s", thetype,
550	num_annots, s);
551	MP_LogEvent(link, MP_WRITE_EVENT, fix_log_msg);
552	}
553	#endif
554
555	if (!imp_put_node_header(link, ntype, 0, 0, num_annots, 0))
556	return MP_Failure;
557
558	if (!common_put_string(link, s))
559	return MP_SetError(link, MP_CantPutNodePacket);
560
561	return MP_ClearError(link);
562	}
563
564
565
566
567	#ifdef __STDC__
568	MP_Status_t MP_PutStringPacket(MP_Link_pt link,
569	char *s,
570	MP_NumAnnot_t num_annots)
571	#else
572	MP_Status_t MP_PutStringPacket(link, s, num_annots)
573	MP_Link_pt link;
574	char *s;
575	MP_NumAnnot_t num_annots;
576	#endif
577	{
578	if (!(imp_put_node_header(link, MP_StringType, 0, 0, num_annots, 0)
579	&& common_put_string(link, s)))
580	return MP_Failure;
581
582	#ifndef NO_LOGGING
583	if (link->logmask & MP_LOG_WRITE_EVENTS) {
584	int len = strlen(s) + 36;
585	char *tmp_msg = IMP_MemAllocFnc(len);
586	sprintf(tmp_msg, "%-12s annots: %lu value: %s", "String_NP",
587	num_annots, s);
588	MP_LogEvent(link, MP_WRITE_EVENT, tmp_msg);
589	IMP_MemFreeFnc(tmp_msg, len);
590	}
591	#endif
592
593	return MP_ClearError(link);
594	}
595
596
597
598
599	#ifdef __STDC__
600	MP_Status_t MP_PutMetaTypePacket(MP_Link_pt link,
601	MP_DictTag_t dtag,
602	char *s,
603	MP_NumAnnot_t num_annots)
604	#else
605	MP_Status_t MP_PutMetaTypePacket(link, dtag, s, num_annots)
606	MP_Link_pt link;
607	MP_DictTag_t dtag;
608	char *s;
609	MP_NumAnnot_t num_annots;
610	#endif
611	{
612	if (!(imp_put_node_header(link, MP_MetaType, dtag, 0, num_annots, 0)
613	&& common_put_string(link, s)))
614	return MP_Failure;
615
616	#ifndef NO_LOGGING
617	if (link->logmask & MP_LOG_WRITE_EVENTS) {
618	sprintf(fix_log_msg, "%-12s annots: %lu dict: %lu value: %s",
619	"MetaType_NP", num_annots, dtag, s);
620	MP_LogEvent(link, MP_WRITE_EVENT, fix_log_msg);
621	}
622	#endif
623
624	return MP_ClearError(link);
625	}
626
627
628
629
630	#ifdef __STDC__
631	MP_Status_t MP_PutCommonOperatorPacket(MP_Link_pt link,
632	MP_DictTag_t dtag,
633	MP_Common_t op,
634	MP_NumAnnot_t num_annots,
635	MP_NumChild_t num_child)
636	#else
637	MP_Status_t MP_PutCommonOperatorPacket(link, dtag, op, num_annots, num_child)
638	MP_Link_pt link;
639	MP_DictTag_t dtag;
640	MP_Common_t op;
641	MP_NumAnnot_t num_annots;
642	MP_NumChild_t num_child;
643	#endif
644	{
645	if (!imp_put_node_header(link, MP_CommonOperatorType, dtag, op, num_annots,
646	num_child))
647	return MP_SetError(link, MP_CantPutNodePacket);
648
649	#ifndef NO_LOGGING
650	if (link->logmask & MP_LOG_WRITE_EVENTS) {
651	log_dicttype(link, MP_WRITE_EVENT, "Common Op_NP",
652	MP_CommonOperatorType,num_annots, dtag, &op, num_child);
653	}
654	#endif
655
656	return MP_ClearError(link);
657	}
658
659
660	#ifdef __STDC__
661	MP_Status_t MP_PutCommonMetaOperatorPacket(MP_Link_pt link,
662	MP_DictTag_t dtag,
663	MP_Common_t op,
664	MP_NumAnnot_t num_annots,
665	MP_NumChild_t num_child)
666	#else
667	MP_Status_t MP_PutCommonMetaOperatorPacket(link, dtag, op, num_annots,
668	num_child)
669	MP_Link_pt link;
670	MP_DictTag_t dtag;
671	MP_Common_t op;
672	MP_NumAnnot_t num_annots;
673	MP_NumChild_t num_child;
674	#endif
675	{
676	if (!imp_put_node_header(link, MP_CommonMetaOperatorType, dtag, op,
677	num_annots, num_child))
678	return MP_SetError(link, MP_CantPutNodePacket);
679
680	#ifndef NO_LOGGING
681	if (link->logmask & MP_LOG_WRITE_EVENTS) {
682	log_dicttype(link, MP_WRITE_EVENT, "Common MetaOp_NP",
683	MP_CommonMetaOperatorType,num_annots, dtag, &op, num_child);
684	}
685	#endif
686
687	return MP_ClearError(link);
688	}
689
690
691
692
693	#ifdef __STDC__
694	MP_Status_t MP_PutCommonMetaTypePacket(MP_Link_pt link,
695	MP_DictTag_t dtag,
696	MP_Common_t cm,
697	MP_NumAnnot_t num_annots)
698	#else
699	MP_Status_t MP_PutCommonMetaTypePacket(link, dtag, cm, num_annots)
700	MP_Link_pt link;
701	MP_DictTag_t dtag;
702	MP_Common_t cm;
703	MP_NumAnnot_t num_annots;
704	#endif
705	{
706	if (!imp_put_node_header(link, MP_CommonMetaType, dtag, cm,num_annots, 0))
707	return MP_SetError(link, MP_CantPutNodePacket);
708
709	#ifndef NO_LOGGING
710	if (link->logmask & MP_LOG_WRITE_EVENTS)
711	log_dicttype(link, MP_WRITE_EVENT, "Common Meta_NP", MP_CommonMetaType,
712	num_annots, dtag, &cm, 0);
713	#endif
714
715	return MP_ClearError(link);
716	}
717
718
719
720	#ifdef __STDC__
721	MP_Status_t MP_PutCommonConstantPacket(MP_Link_pt link,
722	MP_DictTag_t dtag,
723	MP_Common_t cnst,
724	MP_NumAnnot_t num_annots)
725	#else
726	MP_Status_t MP_PutCommonConstantPacket(link, dtag, cnst, num_annots)
727	MP_Link_pt link;
728	MP_DictTag_t dtag;
729	MP_Common_t cnst;
730	MP_NumAnnot_t num_annots;
731	#endif
732	{
733	if (!imp_put_node_header(link, MP_CommonConstantType, dtag, cnst,
734	num_annots, 0))
735	return MP_SetError(link, MP_CantPutNodePacket);
736
737	#ifndef NO_LOGGING
738	if (link->logmask & MP_LOG_WRITE_EVENTS)
739	log_dicttype(link, MP_WRITE_EVENT, "Common Cnst_NP",
740	MP_CommonConstantType, num_annots, dtag, &cnst, 0);
741	#endif
742
743	return MP_ClearError(link);
744	}
745
746
747
748
749	#ifdef __STDC__
750	MP_Status_t MP_PutOperatorPacket(MP_Link_pt link,
751	MP_DictTag_t dtag,
752	char *op,
753	MP_NumAnnot_t num_annots,
754	MP_NumChild_t num_child)
755	#else
756	MP_Status_t MP_PutOperatorPacket(link, dtag, op, num_annots, num_child)
757	MP_Link_pt link;
758	MP_DictTag_t dtag;
759	char *op;
760	MP_NumAnnot_t num_annots;
761	MP_NumChild_t num_child;
762	#endif
763	{
764	if (!(imp_put_node_header(link, MP_OperatorType, dtag, 0, num_annots,
765	num_child) && common_put_string(link, op)))
766	return MP_SetError(link, MP_CantPutNodePacket);
767
768	#ifndef NO_LOGGING
769	if (link->logmask & MP_LOG_WRITE_EVENTS)
770	log_dicttype(link, MP_WRITE_EVENT, "Operator_NP", MP_OperatorType,
771	num_annots, dtag, op, num_child);
772	#endif
773
774	return MP_ClearError(link);
775	}
776
777
778	#ifdef __STDC__
779	MP_Status_t MP_PutMetaOperatorPacket(MP_Link_pt link,
780	MP_DictTag_t dtag,
781	char *op,
782	MP_NumAnnot_t num_annots,
783	MP_NumChild_t num_child)
784	#else
785	MP_Status_t MP_PutMetaOperatorPacket(link, dtag, op, num_annots, num_child)
786	MP_Link_pt link;
787	MP_DictTag_t dtag;
788	char *op;
789	MP_NumAnnot_t num_annots;
790	MP_NumChild_t num_child;
791	#endif
792	{
793	if (!(imp_put_node_header(link, MP_MetaOperatorType, dtag, 0, num_annots,
794	num_child) && common_put_string(link, op)))
795	return MP_SetError(link, MP_CantPutNodePacket);
796
797	#ifndef NO_LOGGING
798	if (link->logmask & MP_LOG_WRITE_EVENTS)
799	log_dicttype(link, MP_WRITE_EVENT, "MetaOperator_NP", MP_MetaOperatorType,
800	num_annots, dtag, op, num_child);
801	#endif
802
803	return MP_ClearError(link);
804	}
805
806
807
808	#ifdef __STDC__
809	MP_Status_t IMP_PutOperator(MP_Link_pt link, char *op)
810	#else
811	MP_Status_t IMP_PutOperator(link, op)
812	MP_Link_pt link;
813	char *op;
814	#endif
815	{
816	if (!common_put_string(link, op))
817	return MP_Failure;
818
819	#ifndef NO_LOGGING
820	if (link->logmask & MP_LOG_WRITE_EVENTS) {
821	sprintf(fix_log_msg, "%-12s op: %s", "Operator_DP", op);
822	MP_LogEvent(link, MP_WRITE_EVENT, fix_log_msg);
823	}
824	#endif
825
826	return MP_ClearError(link);
827	}
828
829
830	#ifdef __STDC__
831	MP_Status_t IMP_PutMetaOperator(MP_Link_pt link, char *op)
832	#else
833	MP_Status_t IMP_PutMetaOperator(link, op)
834	MP_Link_pt link;
835	char *op;
836	#endif
837	{
838	if (!common_put_string(link, op))
839	return MP_Failure;
840
841	#ifndef NO_LOGGING
842	if (link->logmask & MP_LOG_WRITE_EVENTS) {
843	sprintf(fix_log_msg, "%-12s op: %s", "MetaOperator_DP", op);
844	MP_LogEvent(link, MP_WRITE_EVENT, fix_log_msg);
845	}
846	#endif
847
848	return MP_ClearError(link);
849	}
850
851
852	#ifdef __STDC__
853	MP_Status_t IMP_PutApInt(MP_Link_pt link, MP_ApInt_t apint)
854	#else
855	MP_Status_t IMP_PutApInt(link, apint)
856	MP_Link_pt link;
857	MP_ApInt_t apint;
858	#endif
859	{
860	#ifndef NO_LOGGING
861	if (link->logmask & MP_LOG_WRITE_EVENTS)
862	{
863	int len;
864	char *msg = NULL;
865	len = link->bignum.bigint_ops->bigint_ascii_size(apint) + 25;
866	msg = IMP_MemAllocFnc(len);
867	sprintf(msg, "%-12s value: ", "ApInt_DP");
868	link->bignum.bigint_ops->bigint_to_str(apint, &(msg[strlen(msg)]));
869	MP_LogEvent(link, MP_WRITE_EVENT, msg);
870	IMP_MemFreeFnc(msg, len);
871	}
872	#endif
873
874	if (link->bignum.bigint_ops->put_bigint(link, apint) != MP_Success)
875	return MP_SetError(link, MP_CantPutDataPacket);
876
877	return MP_ClearError(link);
878	}
879
880
881	#ifdef __STDC__
882	MP_Status_t MP_PutApIntPacket(MP_Link_pt link,
883	MP_ApInt_t apint,
884	MP_NumAnnot_t num_annots)
885	#else
886	MP_Status_t MP_PutApIntPacket(link, apint, num_annots)
887	MP_Link_pt link;
888	MP_ApInt_t apint;
889	MP_NumAnnot_t num_annots;
890	#endif
891	{
892	if (!imp_put_node_header(link, MP_ApIntType, 0, 0, num_annots, 0))
893	return MP_SetError(link, MP_CantPutNodePacket);
894
895	if (link->bignum.bigint_ops->put_bigint(link, apint) != MP_Success)
896	return MP_SetError(link, MP_CantPutNodePacket);
897
898	#ifndef NO_LOGGING
899	if (link->logmask & MP_LOG_WRITE_EVENTS)
900	{
901	int len;
902	char *msg = NULL;
903	len = link->bignum.bigint_ops->bigint_ascii_size(apint) + 42;
904	msg = IMP_MemAllocFnc(len);
905	sprintf(msg, "%-12s annots: %lu value: ", "ApInt_NP", num_annots);
906	link->bignum.bigint_ops->bigint_to_str(apint, &(msg[strlen(msg)]));
907	MP_LogEvent(link, MP_WRITE_EVENT, msg);
908	IMP_MemFreeFnc(msg, len);
909	}
910	#endif
911	return MP_ClearError(link);
912	}
913
914
915	#ifdef __STDC__
916	MP_Status_t IMP_PutApReal(MP_Link_pt link, MP_ApReal_t apreal)
917	#else
918	MP_Status_t IMP_PutApReal(link, apreal)
919	MP_Link_pt link;
920	MP_ApReal_t apreal;
921	#endif
922	{
923	#ifndef NO_LOGGING
924	if (link->logmask & MP_LOG_WRITE_EVENTS)
925	{
926	int len;
927	char *msg = NULL;
928	len = link->bignum.bigreal_ops->bigreal_ascii_size(apreal) + 25;
929	msg = IMP_MemAllocFnc(len);
930	sprintf(msg, "%-12s value: ", "ApReal_DP");
931	link->bignum.bigreal_ops->bigreal_to_str(apreal, &(msg[strlen(msg)]));
932	MP_LogEvent(link, MP_WRITE_EVENT, msg);
933	IMP_MemFreeFnc(msg, len);
934	}
935	#endif
936
937	if (link->bignum.bigreal_ops->put_bigreal(link, apreal) != MP_Success)
938	return MP_SetError(link, MP_CantPutDataPacket);
939
940	return MP_ClearError(link);
941	}
942
943
944
945	#ifdef __STDC__
946	MP_Status_t MP_PutApRealPacket(MP_Link_pt link,
947	MP_ApReal_t apreal,
948	MP_NumAnnot_t num_annots)
949	#else
950	MP_Status_t MP_PutApRealPacket(link, apreal, num_annots)
951	MP_Link_pt link;
952	MP_ApReal_t apreal;
953	MP_NumAnnot_t num_annots;
954	#endif
955	{
956	if (!imp_put_node_header(link, MP_ApRealType, 0, 0, num_annots, 0))
957	return MP_SetError(link, MP_CantPutNodePacket);
958
959	if (link->bignum.bigreal_ops->put_bigreal(link, apreal) != MP_Success)
960	return MP_SetError(link, MP_CantPutNodePacket);
961
962	#ifndef NO_LOGGING
963	if (link->logmask & MP_LOG_WRITE_EVENTS)
964	{
965	int len;
966	char *msg = NULL;
967	len = link->bignum.bigreal_ops->bigreal_ascii_size(apreal) + 45;
968	msg = IMP_MemAllocFnc(len);
969	sprintf(msg, "%-12s annots: %lu value: ", "ApReal_NP", num_annots);
970	link->bignum.bigreal_ops->bigreal_to_str(apreal, &(msg[strlen(msg)]));
971	MP_LogEvent(link, MP_WRITE_EVENT, msg);
972	IMP_MemFreeFnc(msg, len);
973	}
974	#endif
975
976	return MP_ClearError(link);
977	}
978
979
980	#ifdef __STDC__
981	MP_Status_t MP_PutBooleanPacket(MP_Link_pt link,
982	MP_Boolean_t mbool,
983	MP_NumAnnot_t num_annots)
984	#else
985	MP_Status_t MP_PutBooleanPacket(link, mbool, num_annots)
986	MP_Link_pt link;
987	MP_Boolean_t mbool;
988	MP_NumAnnot_t num_annots;
989	#endif
990	{
991	if (!imp_put_node_header(link, MP_BooleanType, 0, mbool, num_annots, 0))
992	return MP_SetError(link, MP_CantPutNodePacket);
993
994	#ifndef NO_LOGGING
995	if (link->logmask & MP_LOG_WRITE_EVENTS)
996	log_fixnum(link, MP_WRITE_EVENT, "Boolean_NP", MP_BooleanType,
997	num_annots, &mbool);
998	#endif
999
1000	return MP_ClearError(link);
1001	}
1002
1003
1004	#ifdef __STDC__
1005	MP_Status_t IMP_PutBoolean(MP_Link_pt link, MP_Boolean_t mbool)
1006	#else
1007	MP_Status_t IMP_PutBoolean(link, mbool)
1008	MP_Link_pt link;
1009	MP_Boolean_t mbool;
1010	#endif
1011	{
1012	if (!imp_put_node_header(link, MP_BooleanType, 0, mbool, 0, 0))
1013	return MP_SetError(link, MP_CantPutDataPacket);
1014
1015	#ifndef NO_LOGGING
1016	if (link->logmask & MP_LOG_WRITE_EVENTS)
1017	log_fixnum(link, MP_WRITE_EVENT, "Boolean_DP", MP_BooleanType, 0,
1018	&mbool);
1019	#endif
1020
1021	return MP_ClearError(link);
1022	}
1023
1024
1025	#ifdef __STDC__
1026	MP_Status_t MP_PutSint8Packet(MP_Link_pt link,
1027	MP_Sint8_t n,
1028	MP_NumAnnot_t num_annots)
1029	#else
1030	MP_Status_t MP_PutSint8Packet(link, n, num_annots)
1031	MP_Link_pt link;
1032	MP_Sint8_t n;
1033	MP_NumAnnot_t num_annots;
1034	#endif
1035	{
1036	if (!imp_put_node_header(link, MP_Sint8Type, 0, n, num_annots, 0))
1037	return MP_SetError(link, MP_CantPutDataPacket);
1038
1039	#ifndef NO_LOGGING
1040	if (link->logmask & MP_LOG_WRITE_EVENTS)
1041	log_fixnum(link, MP_WRITE_EVENT, "Sint8_NP", MP_Sint8Type,
1042	num_annots, &n);
1043	#endif
1044
1045	return MP_ClearError(link);
1046	}
1047
1048
1049	#ifdef __STDC__
1050	MP_Status_t MP_PutUint8Packet(MP_Link_pt link,
1051	MP_Uint8_t n,
1052	MP_NumAnnot_t num_annots)
1053	#else
1054	MP_Status_t MP_PutUint8Packet(link, n, num_annots)
1055	MP_Link_pt link;
1056	MP_Uint8_t n;
1057	MP_NumAnnot_t num_annots;
1058	#endif
1059	{
1060	/* need the following to make the HPs happy, otherwise it treats the
1061	incoming value as an unsigned integer (2 - 4 bytes)
1062	*/
1063	unsigned char x = (unsigned char) n;
1064
1065	if (!imp_put_node_header(link, MP_Uint8Type, 0, x, num_annots, 0))
1066	return MP_SetError(link, MP_CantPutDataPacket);
1067
1068	#ifndef NO_LOGGING
1069	if (link->logmask & MP_LOG_WRITE_EVENTS)
1070	log_fixnum(link, MP_WRITE_EVENT, "Uint8_NP", MP_Uint8Type,
1071	num_annots, &x);
1072	#endif
1073
1074	return MP_ClearError(link);
1075	}
1076
1077
1078	#ifdef __STDC__
1079	MP_Status_t IMP_PutSint8(MP_Link_pt link, MP_Sint8_t n)
1080	#else
1081	MP_Status_t IMP_PutSint8(link, n)
1082	MP_Link_pt link;
1083	MP_Sint8_t n;
1084	#endif
1085	{
1086	if (!imp_put_node_header(link, MP_Sint8Type, 0, n, 0, 0))
1087	return MP_SetError(link, MP_CantPutDataPacket);
1088
1089	#ifndef NO_LOGGING
1090	if (link->logmask & MP_LOG_WRITE_EVENTS)
1091	log_fixnum(link, MP_WRITE_EVENT, "Sint8_DP", MP_Sint8Type, 0, &n);
1092	#endif
1093
1094	return MP_ClearError(link);
1095	}
1096
1097
1098
1099	#ifdef __STDC__
1100	MP_Status_t IMP_PutUint8(MP_Link_pt link,
1101	MP_Uint8_t n)
1102	#else
1103	MP_Status_t IMP_PutUint8(link, n)
1104	MP_Link_pt link;
1105	MP_Uint8_t n;
1106	#endif
1107	{
1108	/* need the following to make the HPs happy, otherwise it treats the
1109	incoming value as an unsigned integer (2 - 4 bytes)
1110	*/
1111	unsigned char x = (unsigned char) n;
1112	if (!imp_put_node_header(link, MP_Uint8Type, 0, x, 0, 0))
1113	return MP_SetError(link, MP_CantPutDataPacket);
1114
1115	#ifndef NO_LOGGING
1116	if (link->logmask & MP_LOG_WRITE_EVENTS)
1117	log_fixnum(link, MP_WRITE_EVENT, "Uint8_DP", MP_Uint8Type, 0, &x);
1118	#endif
1119
1120	return MP_ClearError(link);
1121	}
1122
1123
1124	#ifdef __STDC__
1125	MP_Status_t MP_PutSint32Packet(MP_Link_pt link,
1126	MP_Sint32_t n,
1127	MP_NumAnnot_t num_annots)
1128	#else
1129	MP_Status_t MP_PutSint32Packet(link, n, num_annots)
1130	MP_Link_pt link;
1131	MP_Sint32_t n;
1132	MP_NumAnnot_t num_annots;
1133	#endif
1134	{
1135	if (! (imp_put_node_header(link, MP_Sint32Type, 0, 0, num_annots, 0)
1136	&& IMP_PutLong(link, &n)))
1137	return MP_SetError(link, MP_CantPutDataPacket);
1138
1139	#ifndef NO_LOGGING
1140	if (link->logmask & MP_LOG_WRITE_EVENTS)
1141	log_fixnum(link, MP_WRITE_EVENT,"Sint32_NP",MP_Sint32Type,
1142	num_annots, &n);
1143	#endif
1144
1145	return MP_ClearError(link);
1146	}
1147
1148
1149	#ifdef __STDC__
1150	MP_Status_t MP_PutUint32Packet(MP_Link_pt link,
1151	MP_Uint32_t n,
1152	MP_NumAnnot_t num_annots)
1153	#else
1154	MP_Status_t MP_PutUint32Packet(link, n, num_annots)
1155	MP_Link_pt link;
1156	MP_Uint32_t n;
1157	MP_NumAnnot_t num_annots;
1158	#endif
1159	{
1160	if (! (imp_put_node_header(link, MP_Uint32Type, 0, 0, num_annots, 0)
1161	&& IMP_PutLong(link, (long*)&n)))
1162	return MP_SetError(link, MP_CantPutDataPacket);
1163
1164	#ifndef NO_LOGGING
1165	if (link->logmask & MP_LOG_WRITE_EVENTS)
1166	log_fixnum(link, MP_WRITE_EVENT,"Uint32_NP",MP_Uint32Type,
1167	num_annots, &n);
1168	#endif
1169
1170	return MP_ClearError(link);
1171	}
1172
1173
1174	#ifdef __STDC__
1175	MP_Status_t MP_PutRawPacket(MP_Link_pt link,
1176	char *data,
1177	MP_Uint32_t len,
1178	MP_NumAnnot_t num_annots)
1179	#else
1180	MP_Status_t MP_PutRawPacket(link, data, len, num_annots)
1181	MP_Link_pt link;
1182	char *data;
1183	MP_Uint32_t len;
1184	MP_NumAnnot_t num_annots;
1185	#endif
1186	{
1187	short extra;
1188
1189	if (!imp_put_node_header(link, MP_RawType, 0, 0, num_annots, 0))
1190	return MP_Failure;
1191
1192	extra = len % MP_BytesPerMPUnit;
1193	extra = MP_BytesPerMPUnit - extra;
1194
1195	if (! (IMP_PutLong(link, (long*)&len) && IMP_PutBytes(link, data, len)))
1196	return MP_SetError(link, MP_CantPutNodePacket);
1197
1198	if (extra != MP_BytesPerMPUnit /* have to pad with extra null bytes */
1199	&& !IMP_PutBytes(link, filler, extra))
1200	return MP_SetError(link, MP_CantPutNodePacket);
1201
1202	#ifndef NO_LOGGING
1203	if (link->logmask & MP_LOG_WRITE_EVENTS) {
1204	sprintf(fix_log_msg,
1205	"%-12s annots: %lu #bytes: %lu (data not shown)",
1206	"Raw_NP", num_annots, len);
1207	MP_LogEvent(link, MP_WRITE_EVENT, fix_log_msg);
1208	}
1209	#endif
1210
1211	return MP_ClearError(link);
1212	}
1213
1214
1215	/*
1216	* NB: Not portable.
1217	* This routine works on Suns (Sky / 68000's) and Vaxen.
1218	*/
1219	#ifdef vax
1220	/* What IEEE single precision floating point looks like on a Vax */
1221	struct ieee_single {
1222	unsigned int mantissa : 23;
1223	unsigned int exp : 8;
1224	unsigned int sign : 1;
1225	};
1226
1227	/* Vax single precision floating point */
1228	struct vax_single {
1229	unsigned int mantissa1 : 7;
1230	unsigned int exp : 8;
1231	unsigned int sign : 1;
1232	unsigned int mantissa2 : 16;
1233
1234	};
1235
1236	#define VAX_SNG_BIAS 0x81
1237	#define IEEE_SNG_BIAS 0x7f
1238
1239	static struct sgl_limits {
1240	struct vax_single s;
1241	struct ieee_single ieee;
1242	} sgl_limits[2] = {
1243	{{ 0x3f, 0xff, 0x0, 0xffff }, /* Max Vax */
1244	{ 0x0, 0xff, 0x0 }}, /* Max IEEE */
1245	{{ 0x0, 0x0, 0x0, 0x0 }, /* Min Vax */
1246	{ 0x0, 0x0, 0x0 }} /* Min IEEE */
1247	};
1248
1249	#endif
1250
1251
1252
1253	#ifdef __STDC__
1254	MP_Status_t IMP_PutReal32(MP_Link_pt link, MP_Real32_t n)
1255	#else
1256	MP_Status_t IMP_PutReal32(link, n)
1257	MP_Link_pt link;
1258	MP_Real32_t n;
1259	#endif
1260	{
1261	float x = n;
1262	float *fp = &x;
1263	#ifdef vax
1264	struct ieee_single is;
1265	struct vax_single vs, *vsp;
1266	struct sgl_limits *lim;
1267	#endif
1268
1269	#ifdef MP_DEBUGGING
1270	fprintf(stderr, "IMP_PutReal32: entering, fp = %-20.10G\n", *fp);
1271	#endif
1272
1273	#ifndef NO_LOGGING
1274	if (link->logmask & MP_LOG_WRITE_EVENTS)
1275	log_fixreal(link, MP_WRITE_EVENT, "Real32_DP", MP_Real32Type, 0, fp);
1276	#endif
1277
1278	#ifndef vax
1279	return IMP_PutLong(link, (long *)fp);
1280	#else /* not vax */
1281	vs = ((struct vax_single )fp);
1282	for (i = 0, lim = sgl_limits;
1283	i < sizeof(sgl_limits)/sizeof(struct sgl_limits); i++, lim++)
1284	if (vs.mantissa2 == lim->s.mantissa2
1285	&& vs.exp == lim->s.exp
1286	&& vs.mantissa1 == lim->s.mantissa1) {
1287	is = lim->ieee;
1288	goto shipit;
1289	}
1290
1291	is.exp = vs.exp - VAX_SNG_BIAS + IEEE_SNG_BIAS;
1292	is.mantissa = (vs.mantissa1 << 16) \| vs.mantissa2;
1293
1294	shipit:
1295	is.sign = vs.sign;
1296	return IMP_PutLong(link, (long *)&is);
1297	#endif /* not vax */
1298	}
1299
1300
1301
1302	/*
1303	* This routine works on Suns (Sky / 68000's) and Vaxen.
1304	*/
1305
1306	#ifdef vax
1307
1308	/* What IEEE double precision floating point looks like on a Vax */
1309	struct ieee_double {
1310	unsigned int mantissa1 : 20;
1311	unsigned int exp : 11;
1312	unsigned int sign : 1;
1313	unsigned int mantissa2 : 32;
1314	};
1315
1316	/* Vax double precision floating point */
1317	struct vax_double {
1318	unsigned int mantissa1 : 7;
1319	unsigned int exp : 8;
1320	unsigned int sign : 1;
1321	unsigned int mantissa2 : 16;
1322	unsigned int mantissa3 : 16;
1323	unsigned int mantissa4 : 16;
1324	};
1325
1326	#define VAX_DBL_BIAS 0x81
1327	#define IEEE_DBL_BIAS 0x3ff
1328	#define MASK(nbits) ((1 << nbits) - 1)
1329
1330	static struct dbl_limits {
1331	struct vax_double d;
1332	struct ieee_double ieee;
1333	} dbl_limits[2] = {
1334	{{ 0x7f, 0xff, 0x0, 0xffff, 0xffff, 0xffff }, /* Max Vax */
1335	{ 0x0, 0x7ff, 0x0, 0x0 }}, /* Max IEEE */
1336	{{ 0x0, 0x0, 0x0, 0x0, 0x0, 0x0}, /* Min Vax */
1337	{ 0x0, 0x0, 0x0, 0x0 }} /* Min IEEE */
1338	};
1339
1340	#endif /* vax */
1341
1342
1343	#ifdef __STDC__
1344	MP_Status_t IMP_PutReal64(MP_Link_pt link, MP_Real64_t n)
1345	#else
1346	MP_Status_t IMP_PutReal64(link, n)
1347	register MP_Link_pt link;
1348	MP_Real64_t n;
1349	#endif
1350	{
1351	register long *lp;
1352	register double *dp = &n;
1353
1354	#ifdef vax
1355	struct ieee_double id;
1356	struct vax_double vd;
1357	register struct dbl_limits *lim;
1358	#endif
1359
1360	#ifdef MP_DEBUGGING
1361	fprintf(stderr, "IMP_PutReal64: entering, dp = %-20.10G\n", *dp);
1362	#endif
1363
1364	#ifndef NO_LOGGING
1365	if (link->logmask & MP_LOG_WRITE_EVENTS)
1366	log_fixreal(link, MP_WRITE_EVENT, "Real64_DP", MP_Real64Type, 0, dp);
1367	#endif
1368
1369	#ifndef vax
1370	lp = (long *)dp;
1371	#else /* not vax */
1372	vd = ((struct vax_double )dp);
1373	for (i = 0, lim = dbl_limits;
1374	i < sizeof(dbl_limits)/sizeof(struct dbl_limits); i++, lim++)
1375	if (vd.mantissa4 == lim->d.mantissa4
1376	&& vd.mantissa3 == lim->d.mantissa3
1377	&& vd.mantissa2 == lim->d.mantissa2
1378	&& vd.mantissa1 == lim->d.mantissa1
1379	&& vd.exp == lim->d.exp) {
1380	id = lim->ieee;
1381	goto shipit;
1382	}
1383
1384	id.exp = vd.exp - VAX_DBL_BIAS + IEEE_DBL_BIAS;
1385	id.mantissa1 = (vd.mantissa1 << 13) \| (vd.mantissa2 >> 3);
1386	id.mantissa2 = ((vd.mantissa2 & MASK(3)) << 29)
1387	\| (vd.mantissa3 << 13) \| ((vd.mantissa4 >> 3) & MASK(13));
1388
1389	shipit:
1390	id.sign = vd.sign;
1391	lp = (long *)&id;
1392	#endif /* not vax */
1393
1394	#ifdef WORDS_BIGENDIAN
1395	return IMP_PutLong(link, lp++) && IMP_PutLong(link, lp);
1396	#else /* not WORDS_BIGENDIAN */
1397	return IMP_PutLong(link, lp+1) && IMP_PutLong(link, lp);
1398	#endif /* not WORDS_BIGENDIAN */
1399	}
1400
1401
1402
1403	#ifdef __STDC__
1404	MP_Status_t MP_PutReal32Packet(MP_Link_pt link,
1405	MP_Real32_t n,
1406	MP_NumAnnot_t num_annots
1407	)
1408	#else
1409	MP_Status_t MP_PutReal32Packet(link, n, num_annots)
1410	MP_Link_pt link;
1411	MP_Real32_t n;
1412	MP_NumAnnot_t num_annots;
1413	#endif
1414	{
1415	#ifdef vax
1416	struct ieee_single is;
1417	struct vax_single vs, *vsp;
1418	struct sgl_limits *lim;
1419	#endif
1420	float x = n;
1421	float *fp = &x;
1422
1423	#ifndef NO_LOGGING
1424	if (link->logmask & MP_LOG_WRITE_EVENTS)
1425	log_fixreal(link, MP_WRITE_EVENT,
1426	"Real32_NP", MP_Real32Type, num_annots, fp);
1427	#endif
1428
1429	if (!imp_put_node_header(link, MP_Real32Type, 0, 0, num_annots, 0))
1430	return MP_SetError(link, MP_CantPutNodePacket);
1431
1432	#ifndef vax
1433	return IMP_PutLong(link, (long *)fp);
1434	#else /* not vax */
1435	vs = ((struct vax_single )fp);
1436	for (i = 0, lim = sgl_limits;
1437	i < sizeof(sgl_limits)/sizeof(struct sgl_limits); i++, lim++)
1438	if (vs.mantissa2 == lim->s.mantissa2
1439	&& vs.exp == lim->s.exp
1440	&& vs.mantissa1 == lim->s.mantissa1) {
1441	is = lim->ieee;
1442	goto shipit;
1443	}
1444
1445	is.exp = vs.exp - VAX_SNG_BIAS + IEEE_SNG_BIAS;
1446	is.mantissa = (vs.mantissa1 << 16) \| vs.mantissa2;
1447
1448	shipit:
1449	is.sign = vs.sign;
1450	return IMP_PutLong(link, (long *)&is);
1451	#endif /* not vax */
1452	}
1453
1454
1455	#ifdef __STDC__
1456	MP_Status_t MP_PutReal64Packet(MP_Link_pt link,
1457	MP_Real64_t n,
1458	MP_NumAnnot_t num_annots
1459	)
1460	#else
1461	MP_Status_t MP_PutReal64Packet(link, n, num_annots)
1462	MP_Link_pt link;
1463	MP_Real64_t n;
1464	MP_NumAnnot_t num_annots;
1465	#endif
1466	{
1467	register long *lp;
1468	register double *dp = &n;
1469
1470	#ifdef vax
1471	struct ieee_double id;
1472	struct vax_double vd;
1473	register struct dbl_limits *lim;
1474	#endif /* vax */
1475
1476	#ifndef NO_LOGGING
1477	if (link->logmask & MP_LOG_WRITE_EVENTS)
1478	log_fixreal(link, MP_WRITE_EVENT,
1479	"Real64_NP", MP_Real64Type, num_annots, dp);
1480	#endif
1481
1482	if (!imp_put_node_header(link, MP_Real64Type, 0, 0, num_annots, 0))
1483	return MP_SetError(link, MP_CantPutNodePacket);
1484
1485	#ifndef vax
1486	lp = (long *)dp;
1487	#else /* not vax */
1488	vd = ((struct vax_double )dp);
1489	for (i = 0, lim = dbl_limits;
1490	i < sizeof(dbl_limits)/sizeof(struct dbl_limits); i++, lim++)
1491	if (vd.mantissa4 == lim->d.mantissa4
1492	&& vd.mantissa3 == lim->d.mantissa3
1493	&& vd.mantissa2 == lim->d.mantissa2
1494	&& vd.mantissa1 == lim->d.mantissa1
1495	&& vd.exp == lim->d.exp) {
1496	id = lim->ieee;
1497	goto shipit;
1498	}
1499
1500	id.exp = vd.exp - VAX_DBL_BIAS + IEEE_DBL_BIAS;
1501	id.mantissa1 = (vd.mantissa1 << 13) \| (vd.mantissa2 >> 3);
1502	id.mantissa2 = ((vd.mantissa2 & MASK(3)) << 29)
1503	\| (vd.mantissa3 << 13) \| ((vd.mantissa4 >> 3) & MASK(13));
1504
1505	shipit:
1506	id.sign = vd.sign;
1507	lp = (long *)&id;
1508	#endif /* not vax */
1509
1510	#ifdef WORDS_BIGENDIAN
1511	return IMP_PutLong(link, lp++) && IMP_PutLong(link, lp);
1512	#else /* WORDS_BIGENDIAN */
1513	return IMP_PutLong(link, lp+1) && IMP_PutLong(link, lp);
1514	#endif /* WORDS_BIGENDIAN */
1515	}
1516
1517

Note: See TracBrowser for help on using the repository browser.

Download in other formats: