charstring.old.c
Go to the documentation of this file.
1 /****************************************************************
2 /* CHARACTER and STRING functions
3 /* 1987-Dec-17
4 /* Copyright(c) Toshihiro MATSUI, ETL, 1988.
5 /****************************************************************/
6 static char *rcsid="@(#)$Id: charstring.old.c,v 1.1.1.1 2003/11/20 07:46:26 eus Exp $";
7 #include <ctype.h>
8 #include "eus.h"
9 
10 extern byte *get_string();
11 
12 pointer CHAR(ctx,n,argv)
13 register context *ctx;
14 register int n;
15 register pointer argv[];
16 { register pointer a=argv[0];
17  ckarg(2);
18  n=ckintval(argv[1]);
19  if (!isstring(a)) error(E_NOSTRING);
20  if (n<0 || vecsize(a)<=n) error(E_ARRAYINDEX);
21 /* This code should be eliminated, because the compiler cannot know if
22  this object is a normal string or a foreign string, thus no optimization.
23  if (elmtypeof(a)==ELM_FOREIGN)
24  return(makeint((a->c.foreign.chars)[n]));
25  else */
26  return(makeint(a->c.str.chars[n]));}
27 
28 pointer SETCHAR(ctx,n,argv)
29 register context *ctx;
30 register int n;
31 register pointer argv[];
32 { register pointer a=argv[0];
33  register int newval=ckintval(argv[2]);
34  ckarg(3);
35  n=ckintval(argv[1]);
36  if (!isstring(a)) error(E_NOSTRING);
37  if (n<0 || vecsize(a)<=n) error(E_ARRAYINDEX);
38 /* if (elmtypeof(a)==ELM_FOREIGN)
39  ((byte *)(a->c.ivec.iv[0]))[n]=newval;
40  else */
41  a->c.str.chars[n]=newval;
42  return(argv[2]);}
43 
44 pointer UPCASEP(ctx,n,argv)
45 register context *ctx;
46 register int n;
47 register pointer argv[];
48 { ckarg(1); n=ckintval(argv[0]);
49  return((isupper(n))?T:NIL);}
50 
51 pointer LOWCASEP(ctx,n,argv)
52 register context *ctx;
53 register int n;
54 register pointer argv[];
55 { ckarg(1); n=ckintval(argv[0]);
56  return((islower(n))?T:NIL);}
57 
58 pointer ALPHAP(ctx,n,argv)
59 register context *ctx;
60 register int n;
61 pointer argv[];
62 { ckarg(1); n=ckintval(argv[0]);
63  return((isalpha(n))?T:NIL);}
64 
65 pointer DIGITP(ctx,n,argv)
66 register context *ctx;
67 register int n;
68 pointer argv[];
69 { ckarg(1); n=ckintval(argv[0]);
70  return((isdigit(n))?T:NIL);}
71 
72 pointer ALNUMP(ctx,n,argv)
73 register context *ctx;
74 register int n;
75 register pointer argv[];
76 { ckarg(1); n=ckintval(argv[0]);
77  return((isalnum(n))?T:NIL);}
78 
79 pointer CHUPCASE(ctx,n,argv)
80 register context *ctx;
81 register int n;
82 pointer argv[];
83 { ckarg(1); n=ckintval(argv[0]);
84  return((islower(n))?(makeint(toupper(n))):argv[0]);}
85 
86 pointer CHDOWNCASE(ctx,n,argv)
87 register context *ctx;
88 register int n;
89 pointer argv[];
90 { ckarg(1); n=ckintval(argv[0]);
91  return((isupper(n))?(makeint(tolower(n))):argv[0]);}
92 
93 pointer STRINGEQ(ctx,n,argv)
94 register context *ctx;
95 int n;
96 register pointer argv[];
97 { register byte *str1, *str2;
98  int start1,end1,start2,end2;
99  register int len;
100  pointer s1=Getstring(argv[0]), s2=Getstring(argv[1]);
101  ckarg(6);
102  start1=ckintval(argv[2]); end1=ckintval(argv[3]);
103  end1=min(end1,vecsize(s1));
104  start2=ckintval(argv[4]); end2=ckintval(argv[5]);
105  end2=min(end2,vecsize(s2));
106  len=end1-start1;
107  if (len!=end2-start2) return(NIL);
108  str1= &s1->c.str.chars[start1]; str2= &s2->c.str.chars[start2];
109  while (len-->0) if (*str1++ != *str2++) return(NIL);
110  return(T);}
111 
113 register context *ctx;
114 int n;
115 register pointer argv[];
116 { register byte *str1, *str2;
117  int start1,end1,start2,end2,ch1,ch2;
118  pointer s1=Getstring(argv[0]),s2=Getstring(argv[1]);
119  register int len;
120  ckarg(6);
121  start1=ckintval(argv[2]); end1=ckintval(argv[3]); end1=min(end1,vecsize(s1));
122  start2=ckintval(argv[4]); end2=ckintval(argv[5]); end2=min(end2,vecsize(s2));
123  len=end1-start1;
124  if (len!=end2-start2) return(NIL);
125  str1= &s1->c.str.chars[start1]; str2= &s2->c.str.chars[start2];
126  while (len-->0) {
127  ch1= *str1++; ch2= *str2++;
128  if (islower(ch1)) ch1=toupper(ch1);
129  if (islower(ch2)) ch2=toupper(ch2);
130  if (ch1!=ch2) return(NIL);}
131  return(T);}
132 
133 /****************************************************************/
134 /* S T R I N G compare
135 /****************************************************************/
136 
137 pointer STR_LT(ctx,n,argv)
138 register context *ctx;
139 int n;
140 register pointer argv[];
141 { ckarg(2);
142  if (strcmp(get_string(argv[0]),get_string(argv[1]))<0) return(T);
143  else return(NIL);}
144 
145 pointer STR_LE(ctx,n,argv)
146 register context *ctx;
147 int n;
148 register pointer argv[];
149 { ckarg(2);
150  if (strcmp(get_string(argv[0]),get_string(argv[1]))<=0) return(T);
151  else return(NIL);}
152 
153 pointer STR_EQ(ctx,n,argv)
154 register context *ctx;
155 int n;
156 register pointer argv[];
157 { ckarg(2);
158  if (strcmp(get_string(argv[0]),get_string(argv[1]))==0) return(T);
159  else return(NIL);}
160 
161 pointer STR_GT(ctx,n,argv)
162 register context *ctx;
163 int n;
164 register pointer argv[];
165 { ckarg(2);
166  if (strcmp(get_string(argv[0]),get_string(argv[1]))>0) return(T);
167  else return(NIL);}
168 
169 pointer STR_GE(ctx,n,argv)
170 register context *ctx;
171 int n;
172 register pointer argv[];
173 { ckarg(2);
174  if (strcmp(get_string(argv[0]),get_string(argv[1]))>=0) return(T);
175  else return(NIL);}
176 
177 /* initializers */
178 
179 charstring(ctx,mod)
180 register context *ctx;
181 register pointer mod;
182 {
183  defun(ctx,"CHAR",mod,CHAR,NULL);
184  defun(ctx,"SCHAR",mod,CHAR,NULL);
185  defun(ctx,"SETCHAR",mod,SETCHAR,NULL);
186  defun(ctx,"ALPHA-CHAR-P",mod,ALPHAP,NULL);
187  defun(ctx,"UPPER-CASE-P",mod,UPCASEP,NULL);
188  defun(ctx,"LOWER-CASE-P",mod,LOWCASEP,NULL);
189  defun(ctx,"DIGIT-CHAR-P",mod,DIGITP,NULL);
190  defun(ctx,"ALPHANUMERICP",mod,ALNUMP,NULL);
191  defun(ctx,"CHAR-UPCASE",mod,CHUPCASE,NULL);
192  defun(ctx,"CHAR-DOWNCASE",mod,CHDOWNCASE,NULL);
193  defun(ctx,"STRINGEQ",mod,STRINGEQ,NULL);
194  defun(ctx,"STRINGEQUAL",mod,STRINGEQUAL,NULL);
195  defun(ctx,"STRING<",mod,STR_LT,NULL);
196  defun(ctx,"STRING<=",mod,STR_LE,NULL);
197  defun(ctx,"STRING=",mod,STR_EQ,NULL);
198  defun(ctx,"STRING>",mod,STR_GT,NULL);
199  defun(ctx,"STRING>=",mod,STR_GE,NULL);
200 
201  }
202 
Getstring
pointer Getstring()
NIL
pointer NIL
Definition: eus.c:110
defun
defun("ADR_TO_STRING", mod, ADR_TO_STRING)
STR_GE
pointer STR_GE(context *ctx, int n, argv)
Definition: charstring.old.c:169
makeint
#define makeint(v)
Definition: sfttest.c:2
context
Definition: eus.h:524
LOWCASEP
pointer LOWCASEP(context *ctx, int n, argv)
Definition: charstring.old.c:51
STR_EQ
pointer STR_EQ(context *ctx, int n, argv)
Definition: charstring.old.c:153
SETCHAR
pointer SETCHAR(context *ctx, int n, argv)
Definition: charstring.old.c:28
min
#define min(x, y)
Definition: rmflags.c:17
T
pointer T
Definition: eus.c:110
eus.h
UPCASEP
pointer UPCASEP(context *ctx, int n, argv)
Definition: charstring.old.c:44
rcsid
static char * rcsid
Definition: charstring.old.c:6
E_NOSTRING
@ E_NOSTRING
Definition: eus.h:957
STRINGEQUAL
pointer STRINGEQUAL(context *ctx, int n, argv)
Definition: charstring.old.c:112
string::chars
byte chars[1]
Definition: eus.h:212
cell::c
union cell::cellunion c
E_ARRAYINDEX
@ E_ARRAYINDEX
Definition: eus.h:967
NULL
#define NULL
Definition: transargv.c:8
ALNUMP
pointer ALNUMP(context *ctx, int n, argv)
Definition: charstring.old.c:72
STRINGEQ
pointer STRINGEQ(context *ctx, int n, argv)
Definition: charstring.old.c:93
CHUPCASE
pointer CHUPCASE(context *ctx, int n, argv)
Definition: charstring.old.c:79
STR_GT
pointer STR_GT(context *ctx, int n, argv)
Definition: charstring.old.c:161
ALPHAP
pointer ALPHAP(context *ctx, int n, argv)
Definition: charstring.old.c:58
get_string
byte * get_string()
error
pointer error(enum errorcode ec,...) pointer error(va_alist) va_dcl
Definition: eus.c:297
CHAR
pointer CHAR(context *ctx, int n, argv)
Definition: charstring.old.c:12
cell
Definition: eus.h:381
DIGITP
pointer DIGITP(context *ctx, int n, argv)
Definition: charstring.old.c:65
a
char a[26]
Definition: freq.c:4
charstring
charstring(context *ctx, pointer mod)
Definition: charstring.old.c:179
n
GLfloat n[6][3]
Definition: cube.c:15
CHDOWNCASE
pointer CHDOWNCASE(context *ctx, int n, argv)
Definition: charstring.old.c:86
STR_LE
pointer STR_LE(context *ctx, int n, argv)
Definition: charstring.old.c:145
ckarg
ckarg(2)
cell::cellunion::str
struct string str
Definition: eus.h:402
STR_LT
pointer STR_LT(context *ctx, int n, argv)
Definition: charstring.old.c:137


euslisp
Author(s): Toshihiro Matsui
autogenerated on Thu Jun 15 2023 02:06:43