1 /* Part of SWI-Prolog
2
3 Author: Jan Wielemaker
4 E-mail: J.Wielemaker@vu.nl
5 WWW: http://www.swi-prolog.org
6 Copyright (c) 2011-2014, University of Amsterdam
7 All rights reserved.
8
9 Redistribution and use in source and binary forms, with or without
10 modification, are permitted provided that the following conditions
11 are met:
12
13 1. Redistributions of source code must retain the above copyright
14 notice, this list of conditions and the following disclaimer.
15
16 2. Redistributions in binary form must reproduce the above copyright
17 notice, this list of conditions and the following disclaimer in
18 the documentation and/or other materials provided with the
19 distribution.
20
21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
24 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
25 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
26 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
27 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
28 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
29 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
30 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
31 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
32 POSSIBILITY OF SUCH DAMAGE.
33 */
34
35 #include "pl-incl.h"
36 #include "../pl-codelist.h"
37
38 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
39 codes_or_chars_to_buffer(term_t l, unsigned int flags, int wide,
40 CVT_code *status)
41
42 If l represents a list of codes or characters, return a buffer holding
43 the characters. If wide == TRUE the buffer contains objects of type
44 pl_wchar_t. Otherwise it contains traditional characters.
45 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
46
47 Buffer
codes_or_chars_to_buffer(term_t l,unsigned int flags,int wide,CVT_result * result)48 codes_or_chars_to_buffer(term_t l, unsigned int flags, int wide,
49 CVT_result *result)
50 { GET_LD
51 Buffer b;
52 word list = valHandle(l);
53 word slow;
54 Word arg, tail;
55 int step_slow = TRUE;
56 enum { CHARS, CODES } type;
57
58 if ( isList(list) )
59 { intptr_t c = -1;
60
61 arg = argTermP(list, 0);
62 deRef(arg);
63
64 if ( isTaggedInt(*arg) )
65 { c = valInt(*arg);
66 type = CODES;
67 } else
68 { c = charCode(*arg);
69 type = CHARS;
70 }
71
72 result->culprit = *arg;
73 if ( c < 0 || c > 0x10ffff || (!wide && c > 0xff) )
74 { if ( canBind(*arg) )
75 result->status = CVT_partial;
76 else if ( c < 0 || c > 0x10ffff )
77 result->status = CVT_nocode;
78 #if SIZEOF_WCHAR_T == 2
79 else if ( c > PLMAXWCHAR )
80 result->status = CVT_representation;
81 #endif
82 else if ( c > 0xff )
83 result->status = CVT_wide;
84 return NULL;
85 }
86 } else if ( isNil(list) )
87 { return findBuffer(flags);
88 } else
89 { if ( canBind(list) )
90 result->status = CVT_partial;
91 else
92 result->status = CVT_nolist;
93
94 return NULL;
95 }
96
97 b = findBuffer(flags);
98
99 slow = list;
100 while( isList(list) )
101 { intptr_t c = -1;
102
103 arg = argTermP(list, 0);
104 deRef(arg);
105
106 switch(type)
107 { case CODES:
108 if ( isTaggedInt(*arg) )
109 c = valInt(*arg);
110 break;
111 case CHARS:
112 c = charCode(*arg);
113 break;
114 }
115
116 if ( c < 0 || c > 0x10ffff || (!wide && c > 0xff) )
117 { result->culprit = *arg;
118
119 unfindBuffer(b, flags);
120 if ( canBind(*arg) )
121 result->status = CVT_partial;
122 else if ( c < 0 || c > 0x10ffff )
123 result->status = (type == CODES ? CVT_nocode : CVT_nochar);
124 #if SIZEOF_WCHAR_T == 2
125 else if ( c > PLMAXWCHAR )
126 result->status = CVT_representation;
127 #endif
128 else if ( c > 0xff )
129 result->status = CVT_wide;
130 return NULL;
131 }
132
133 if ( wide )
134 addBuffer(b, (pl_wchar_t)c, pl_wchar_t);
135 else
136 addBuffer(b, (unsigned char)c, unsigned char);
137
138 tail = argTermP(list, 1);
139 deRef(tail);
140 list = *tail;
141 if ( list == slow ) /* cyclic */
142 { unfindBuffer(b, flags);
143 result->status = CVT_nolist;
144 return NULL;
145 }
146 if ( (step_slow = !step_slow) )
147 { tail = argTermP(slow, 1);
148 deRef(tail);
149 slow = *tail;
150 }
151 }
152 if ( !isNil(list) )
153 { unfindBuffer(b, flags);
154 if ( canBind(list) )
155 result->status = CVT_partial;
156 else
157 result->status = CVT_nolist;
158 return NULL;
159 }
160
161 result->status = CVT_ok;
162
163 return b;
164 }
165