source: git/MP/MP/MP_Put.c @ 7adb502

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