Annotation of OpenXM_contrib2/asir2000/builtin/strobj.c, Revision 1.13
1.6 noro 1: /*
2: * Copyright (c) 1994-2000 FUJITSU LABORATORIES LIMITED
3: * All rights reserved.
4: *
5: * FUJITSU LABORATORIES LIMITED ("FLL") hereby grants you a limited,
6: * non-exclusive and royalty-free license to use, copy, modify and
7: * redistribute, solely for non-commercial and non-profit purposes, the
8: * computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and
9: * conditions of this Agreement. For the avoidance of doubt, you acquire
10: * only a limited right to use the SOFTWARE hereunder, and FLL or any
11: * third party developer retains all rights, including but not limited to
12: * copyrights, in and to the SOFTWARE.
13: *
14: * (1) FLL does not grant you a license in any way for commercial
15: * purposes. You may use the SOFTWARE only for non-commercial and
16: * non-profit purposes only, such as academic, research and internal
17: * business use.
18: * (2) The SOFTWARE is protected by the Copyright Law of Japan and
19: * international copyright treaties. If you make copies of the SOFTWARE,
20: * with or without modification, as permitted hereunder, you shall affix
21: * to all such copies of the SOFTWARE the above copyright notice.
22: * (3) An explicit reference to this SOFTWARE and its copyright owner
23: * shall be made on your publication or presentation in any form of the
24: * results obtained by use of the SOFTWARE.
25: * (4) In the event that you modify the SOFTWARE, you shall notify FLL by
1.7 noro 26: * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
1.6 noro 27: * for such modification or the source code of the modified part of the
28: * SOFTWARE.
29: *
30: * THE SOFTWARE IS PROVIDED AS IS WITHOUT ANY WARRANTY OF ANY KIND. FLL
31: * MAKES ABSOLUTELY NO WARRANTIES, EXPRESSED, IMPLIED OR STATUTORY, AND
32: * EXPRESSLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS
33: * FOR A PARTICULAR PURPOSE OR NONINFRINGEMENT OF THIRD PARTIES'
34: * RIGHTS. NO FLL DEALER, AGENT, EMPLOYEES IS AUTHORIZED TO MAKE ANY
35: * MODIFICATIONS, EXTENSIONS, OR ADDITIONS TO THIS WARRANTY.
36: * UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, TORT, CONTRACT,
37: * OR OTHERWISE, SHALL FLL BE LIABLE TO YOU OR ANY OTHER PERSON FOR ANY
38: * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, PUNITIVE OR CONSEQUENTIAL
39: * DAMAGES OF ANY CHARACTER, INCLUDING, WITHOUT LIMITATION, DAMAGES
40: * ARISING OUT OF OR RELATING TO THE SOFTWARE OR THIS AGREEMENT, DAMAGES
41: * FOR LOSS OF GOODWILL, WORK STOPPAGE, OR LOSS OF DATA, OR FOR ANY
42: * DAMAGES, EVEN IF FLL SHALL HAVE BEEN INFORMED OF THE POSSIBILITY OF
43: * SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. EVEN IF A PART
44: * OF THE SOFTWARE HAS BEEN DEVELOPED BY A THIRD PARTY, THE THIRD PARTY
45: * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
46: * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
47: *
1.13 ! noro 48: * $OpenXM: OpenXM_contrib2/asir2000/builtin/strobj.c,v 1.12 2004/02/26 07:06:31 noro Exp $
1.6 noro 49: */
1.1 noro 50: #include "ca.h"
51: #include "parse.h"
52: #include "ctype.h"
1.10 ohara 53: #if defined(PARI)
1.1 noro 54: #include "genpari.h"
1.11 saito 55: # if !(PARI_VERSION_CODE > 131588)
1.1 noro 56: extern jmp_buf environnement;
1.11 saito 57: # endif
1.1 noro 58: #endif
1.5 noro 59: #include <string.h>
60:
1.1 noro 61: extern char *parse_strp;
62:
63: void Prtostr(), Pstrtov(), Peval_str();
1.3 noro 64: void Pstrtoascii(), Pasciitostr();
1.5 noro 65: void Pstr_len(), Pstr_chr(), Psub_str();
1.13 ! noro 66: void Popen_textbuffer();
! 67: void Pclose_textbuffer();
! 68: void Pwrite_to_textbuffer();
! 69: void Ptextbuffer_to_string();
1.1 noro 70:
71: struct ftab str_tab[] = {
72: {"rtostr",Prtostr,1},
73: {"strtov",Pstrtov,1},
74: {"eval_str",Peval_str,1},
1.3 noro 75: {"strtoascii",Pstrtoascii,1},
76: {"asciitostr",Pasciitostr,1},
1.5 noro 77: {"str_len",Pstr_len,1},
78: {"str_chr",Pstr_chr,3},
79: {"sub_str",Psub_str,3},
1.13 ! noro 80: {"open_textbuffer",Popen_textbuffer,0},
! 81: {"close_textbuffer",Pclose_textbuffer,1},
! 82: {"write_to_textbuffer",Pwrite_to_textbuffer,2},
! 83: {"textbuffer_to_string",Ptextbuffer_to_string,1},
1.1 noro 84: {0,0,0},
85: };
1.13 ! noro 86:
! 87: typedef struct oAsirTextBuffer {
! 88: int size,next;
! 89: char **body;
! 90: } *AsirTextBuffer;
! 91:
! 92: static AsirTextBuffer *TBArray;
! 93: static int TBArrayLen;
! 94:
! 95: void Popen_textbuffer(Q *rp)
! 96: {
! 97: int i;
! 98: AsirTextBuffer tb;
! 99:
! 100: if ( !TBArray ) {
! 101: TBArrayLen = 256;
! 102: TBArray = (AsirTextBuffer *)MALLOC(TBArrayLen*sizeof(AsirTextBuffer));
! 103: }
! 104: for ( i = 0; i < TBArrayLen; i++ )
! 105: if ( !TBArray[i] ) break;
! 106: if ( i == TBArrayLen ) {
! 107: TBArrayLen *= 2;
! 108: TBArray = (AsirTextBuffer *)REALLOC(TBArray,
! 109: TBArrayLen*sizeof(AsirTextBuffer));
! 110: }
! 111: TBArray[i] = tb = (AsirTextBuffer)MALLOC(sizeof(struct oAsirTextBuffer));
! 112: tb->size = 256;
! 113: tb->next = 0;
! 114: tb->body = (char **)MALLOC(tb->size*sizeof(char *));
! 115: STOQ(i,*rp);
! 116: }
! 117:
! 118: void Pclose_textbuffer(NODE arg,Q *rp)
! 119: {
! 120: int i;
! 121:
! 122: i = QTOS((Q)ARG0(arg));
! 123: if ( i >= 0 && i < TBArrayLen )
! 124: TBArray[i] = 0;
! 125: else
! 126: error("close_textbuffer : invalid argument");
! 127: *rp = 0;
! 128: }
! 129:
! 130: void Pwrite_to_textbuffer(NODE arg,Q *rp)
! 131: {
! 132: int i;
! 133: AsirTextBuffer tb;
! 134:
! 135: i = QTOS((Q)ARG0(arg));
! 136: if ( i >= 0 && i < TBArrayLen && (tb = TBArray[i])) {
! 137: if ( tb->next == tb->size ) {
! 138: tb->size *= 2;
! 139: tb->body = (char **)REALLOC(tb->body,tb->size*sizeof(char *));
! 140: }
! 141: tb->body[tb->next] = BDY((STRING)ARG1(arg));
! 142: tb->next++;
! 143: } else
! 144: error("write_to_textbuffer : invalid argument");
! 145: *rp = 0;
! 146: }
! 147:
! 148: void Ptextbuffer_to_string(NODE arg,STRING *rp)
! 149: {
! 150: int i,j,len;
! 151: AsirTextBuffer tb;
! 152: char *all,*p,*q;
! 153:
! 154: i = QTOS((Q)ARG0(arg));
! 155: if ( i >= 0 && i < TBArrayLen && (tb = TBArray[i])) {
! 156: tb = TBArray[i];
! 157: for ( j = 0, len = 0; j < tb->next; j++ )
! 158: len += strlen(tb->body[j]);
! 159: all = (char *)MALLOC_ATOMIC((len+1)*sizeof(char));
! 160: for ( j = 0, p = all; j < tb->next; j++ )
! 161: for ( q = tb->body[j]; *q; *p++ = *q++ );
! 162: *p = 0;
! 163: MKSTR(*rp,all);
! 164: } else
! 165: error("textbuffer_to_string : invalid argument");
! 166: }
1.5 noro 167:
168: void Pstr_len(arg,rp)
169: NODE arg;
170: Q *rp;
171: {
172: STRING str;
173: int r;
174:
175: str = (STRING)ARG0(arg);
176: asir_assert(str,O_STR,"str_chr");
177: r = strlen(BDY(str));
178: STOQ(r,*rp);
179: }
180:
181: void Pstr_chr(arg,rp)
182: NODE arg;
183: Q *rp;
184: {
185: STRING str,terminator;
186: Q start;
187: char *p,*ind;
188: int chr,spos,r;
189:
190: str = (STRING)ARG0(arg);
191: start = (Q)ARG1(arg);
192: terminator = (STRING)ARG2(arg);
193: asir_assert(str,O_STR,"str_chr");
194: asir_assert(start,O_N,"str_chr");
195: asir_assert(terminator,O_STR,"str_chr");
196: p = BDY(str);
197: spos = QTOS(start);
198: chr = BDY(terminator)[0];
1.8 noro 199: if ( spos > (int)strlen(p) )
1.5 noro 200: r = -1;
201: else {
202: ind = strchr(p+spos,chr);
203: if ( ind )
204: r = ind-p;
205: else
206: r = -1;
207: }
208: STOQ(r,*rp);
209: }
210:
211: void Psub_str(arg,rp)
212: NODE arg;
213: STRING *rp;
214: {
215: STRING str;
216: Q head,tail;
217: char *p,*r;
218: int spos,epos,len;
219:
220: str = (STRING)ARG0(arg);
221: head = (Q)ARG1(arg);
222: tail = (Q)ARG2(arg);
223: asir_assert(str,O_STR,"sub_str");
224: asir_assert(head,O_N,"sub_str");
225: asir_assert(tail,O_N,"sub_str");
226: p = BDY(str);
227: spos = QTOS(head);
228: epos = QTOS(tail);
229: len = strlen(p);
230: if ( (spos >= len) || (epos < spos) ) {
231: *rp = 0; return;
232: }
233: if ( epos >= len )
234: epos = len-1;
235: len = epos-spos+1;
236: r = (char *)MALLOC(len+1);
237: strncpy(r,p+spos,len);
238: r[len] = 0;
239: MKSTR(*rp,r);
240: }
1.3 noro 241:
242: void Pstrtoascii(arg,rp)
243: NODE arg;
244: LIST *rp;
245: {
246: STRING str;
247: unsigned char *p;
248: int len,i;
249: NODE n,n1;
250: Q q;
251:
252: str = (STRING)ARG0(arg);
253: asir_assert(str,O_STR,"strtoascii");
254: p = BDY(str);
255: len = strlen(p);
256: for ( i = len-1, n = 0; i >= 0; i-- ) {
257: UTOQ((unsigned int)p[i],q);
258: MKNODE(n1,q,n);
259: n = n1;
260: }
261: MKLIST(*rp,n);
262: }
263:
264: void Pasciitostr(arg,rp)
265: NODE arg;
266: STRING *rp;
267: {
268: LIST list;
269: unsigned char *p;
270: int len,i,j;
271: NODE n;
272: Q q;
273:
274: list = (LIST)ARG0(arg);
275: asir_assert(list,O_LIST,"asciitostr");
276: n = BDY(list);
277: len = length(n);
278: p = MALLOC_ATOMIC(len+1);
279: for ( i = 0; i < len; i++, n = NEXT(n) ) {
280: q = (Q)BDY(n);
281: asir_assert(q,O_N,"asciitostr");
282: j = QTOS(q);
1.4 noro 283: if ( j >= 256 || j <= 0 )
1.3 noro 284: error("asciitostr : argument out of range");
285: p[i] = j;
286: }
287: p[i] = 0;
288: MKSTR(*rp,(char *)p);
289: }
1.1 noro 290:
291: void Peval_str(arg,rp)
292: NODE arg;
293: Obj *rp;
294: {
295: FNODE fnode;
296: char *cmd;
1.10 ohara 297: #if defined(PARI)
1.8 noro 298: void recover(int);
299:
1.1 noro 300: recover(0);
1.11 saito 301: # if !(PARI_VERSION_CODE > 131588)
1.1 noro 302: if ( setjmp(environnement) ) {
303: avma = top; recover(1);
304: resetenv("");
305: }
1.11 saito 306: # endif
1.1 noro 307: #endif
308: cmd = BDY((STRING)ARG0(arg));
1.9 noro 309: exprparse_create_var(0,cmd,&fnode);
1.1 noro 310: *rp = eval(fnode);
311: }
312:
313: void Prtostr(arg,rp)
314: NODE arg;
315: STRING *rp;
316: {
317: char *b;
318: int len;
319:
1.2 noro 320: len = estimate_length(CO,ARG0(arg));
1.12 noro 321: b = (char *)MALLOC_ATOMIC(len+1);
1.1 noro 322: soutput_init(b);
323: sprintexpr(CO,ARG0(arg));
324: MKSTR(*rp,b);
325: }
326:
327: void Pstrtov(arg,rp)
328: NODE arg;
329: P *rp;
330: {
1.8 noro 331: char *p;
1.1 noro 332:
333: p = BDY((STRING)ARG0(arg));
334: #if 0
335: if ( !islower(*p) )
336: *rp = 0;
337: else {
338: for ( t = p+1; t && (isalnum(*t) || *t == '_'); t++ );
339: if ( *t )
340: *rp = 0;
341: else
342: makevar(p,rp);
343: }
344: #else
345: makevar(p,rp);
346: #endif
347: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>