Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/runtime/gc/record-ops.c
ViewVC logotype

Annotation of /sml/trunk/src/runtime/gc/record-ops.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 651 - (view) (download) (as text)

1 : monnier 249 /* record-ops.c
2 :     *
3 :     * COPYRIGHT (c) 1998 Bell Labs, Lucent Technologies.
4 :     *
5 :     * Some (type unsafe) operations on records.
6 :     */
7 :    
8 :    
9 :     #include "ml-base.h"
10 :     #include "ml-values.h"
11 :     #include "ml-state.h"
12 :     #include "ml-objects.h"
13 :     #include "arena-id.h"
14 :     #include "gc.h"
15 :    
16 :    
17 :     /* GetLen:
18 :     *
19 :     * Check that we really have a record object, and return its length.
20 :     */
21 :     PVT int GetLen (ml_val_t r)
22 :     {
23 :     ml_val_t d;
24 :     int t;
25 :    
26 :     if (! isBOXED(r))
27 :     return -1;
28 :    
29 :     switch (EXTRACT_OBJC(ADDR_TO_PAGEID(BIBOP, r))) {
30 :     case OBJC_new:
31 :     d = OBJ_DESC(r);
32 :     t = GET_TAG(d);
33 :     if (t == DTAG_record)
34 :     return GET_LEN(d);
35 :     else
36 :     return -1;
37 :     case OBJC_pair: return 2;
38 :     case OBJC_record:
39 :     d = OBJ_DESC(r);
40 :     t = GET_TAG(d);
41 :     if (t == DTAG_record)
42 :     return GET_LEN(d);
43 :     else
44 :     return -1;
45 :     default:
46 :     return -1;
47 :     }
48 :    
49 :     }
50 :    
51 :     /* RecordConcat:
52 :     *
53 :     * Concatenate two records; returns unit if either argument is not
54 :     * a record of length at least one.
55 :     */
56 :     ml_val_t RecordConcat (ml_state_t *msp, ml_val_t r1, ml_val_t r2)
57 :     {
58 :     int l1 = GetLen(r1);
59 :     int l2 = GetLen(r2);
60 :    
61 :     if ((l1 > 0) && (l2 > 0)) {
62 :     int n = l1+l2;
63 :     int i, j;
64 :     ml_val_t *p, res;
65 :    
66 :     ML_AllocWrite (msp, 0, MAKE_DESC(n, DTAG_record));
67 :     j = 1;
68 :     for (i = 0, p = PTR_MLtoC(ml_val_t, r1); i < l1; i++, j++) {
69 :     ML_AllocWrite (msp, j, p[i]);
70 :     }
71 :     for (i = 0, p = PTR_MLtoC(ml_val_t, r2); i < l2; i++, j++) {
72 :     ML_AllocWrite (msp, j, p[i]);
73 :     }
74 :     res = ML_Alloc(msp, n);
75 :     return res;
76 :     }
77 :     else {
78 :     return ML_unit;
79 :     }
80 :    
81 :     } /* end of RecordConcat */
82 :    

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0