newstr.c
Go to the documentation of this file.
1 #include "/tmp_mnt/net/etlic2/usr/local/eus/c/eus.h"
2 #include "newstr.h"
3 extern pointer loadglobal(),storeglobal();
4 static pointer module,*qv,codevec,quotevec;
5 
6 
7 /*newstr1*/
8 static pointer F50(n,argv,env)
9 register int n; register pointer argv[]; pointer env;
10 { register pointer *local=vsp, w, *fqv=qv;
11  if (n!=1) maerror();
12  local[0]= argv[0];
13  vsp=local+1;
14  w=(pointer)LENGTH(1,local+0); /*length*/
15  local[0]= w;
16  local[1]= makeint(0);
17  local[2]= makeint(0);
18  local[3]= local[0];
19  vsp=local+4;
20  w=fcall(1,local+3,fqv[0]); /*make-string*/
21  local[3]= w;
22 whl52:
23  local[4]= local[1];
24  local[5]= (pointer)((int)(local[0])-4);
25  vsp=local+6;
26  w=(pointer)LESSP(2,local+4); /*<*/
27  if (w==NIL) goto whx53;
28  local[4]= makeint(94);
29  local[5]= argv[0];
30  { register int i=intval(local[1]);
31  w=makeint(local[5]->c.str.chars[i]);}
32  local[5]= w;
33  vsp=local+6;
34  w=(pointer)NUMEQUAL(2,local+4); /*=*/
35  if (w==NIL) goto con56;
36  local[4]= makeint(73);
37  local[5]= argv[0];
38  { register int i=intval((pointer)((int)(local[1])+4));
39  w=makeint(local[5]->c.str.chars[i]);}
40  local[5]= w;
41  vsp=local+6;
42  w=(pointer)NUMEQUAL(2,local+4); /*=*/
43  if (w==NIL) goto con56;
44  local[4]= local[3];
45  local[5]= local[2];
46  w = makeint(9);
47  { register int i; register pointer v;
48  i=intval(local[5]); v=local[4];
49  v->c.str.chars[i]=intval(w);}
50  local[1] = (pointer)((int)(local[1])+4);
51  local[4]= local[1];
52  goto con55;
53 con56:
54  local[4]= local[3];
55  local[5]= local[2];
56  local[6]= argv[0];
57  { register int i=intval(local[1]);
58  w=makeint(local[6]->c.str.chars[i]);}
59  { register int i; register pointer v;
60  i=intval(local[5]); v=local[4];
61  v->c.str.chars[i]=intval(w);}
62  local[4]= w;
63  goto con55;
64 con57:
65  local[4]= NIL;
66 con55:
67  local[1] = (pointer)((int)(local[1])+4);
68  local[2] = (pointer)((int)(local[2])+4);
69  goto whl52;
70 whx53:
71  local[4]= NIL;
72 blk54:
73  local[4]= local[3];
74  local[5]= makeint(0);
75  local[6]= local[2];
76  vsp=local+7;
77  w=(pointer)SUBSEQ(3,local+4); /*subseq*/
78  local[0]= w;
79 blk51:
80  vsp=local; return(local[0]);}
81 
82 /*newstr*/
83 static pointer F58(n,argv,env)
84 register int n; register pointer argv[]; pointer env;
85 { register pointer *local=vsp, w, *fqv=qv;
86  if (n!=1) maerror();
87  w = argv[0];
88  if (!isstring(w)) goto if60;
89  local[0]= argv[0];
90  vsp=local+1;
91  w=(pointer)F50(1,local+0); /*newstr1*/
92  local[0]= w;
93  goto if61;
94 if60:
95  w = argv[0];
96  if (!iscons(w)) goto if62;
97  local[0]= xcar(argv[0]);
98  vsp=local+1;
99  w=(pointer)F58(1,local+0); /*newstr*/
100  local[0]= w;
101  local[1]= xcdr(argv[0]);
102  vsp=local+2;
103  w=(pointer)F58(1,local+1); /*newstr*/
104  vsp=local+1;
105  local[0]= cons(local[0],w);
106  goto if63;
107 if62:
108  local[0]= argv[0];
109 if63:
110 if61:
111  w = local[0];
112  local[0]= w;
113 blk59:
114  vsp=local; return(local[0]);}
115 
116 /*newstrfile*/
117 static pointer F64(n,argv,env)
118 register int n; register pointer argv[]; pointer env;
119 { register pointer *local=vsp, w, *fqv=qv;
120  if (n!=2) maerror();
121  local[0]= NIL;
122  vsp=local+1;
123  w=(pointer)GENSYM(0,local+1); /*gensym*/
124  local[1]= w;
125  local[2]= argv[1];
126  local[3]= fqv[1];
127  local[4]= fqv[2];
128  vsp=local+5;
129  w=fcall(3,local+2,fqv[3]); /*open*/
130  local[2]= w;
131  vsp=local+3;
132  w = makeclosure(codevec,quotevec,uwp66,argv,local);
133  local[3]=(pointer)(protfp); local[4]=w; protfp=(struct protectframe *)(local+3);
134  local[5]= argv[0];
135  vsp=local+6;
136  w=fcall(1,local+5,fqv[3]); /*open*/
137  local[5]= w;
138  vsp=local+6;
139  w = makeclosure(codevec,quotevec,uwp67,argv,local);
140  local[6]=(pointer)(protfp); local[7]=w; protfp=(struct protectframe *)(local+6);
141 tag70:
142  local[8]= local[5];
143  local[9]= NIL;
144  local[10]= local[1];
145  vsp=local+11;
146  w=(pointer)READ(3,local+8); /*read*/
147  local[0] = w;
148  local[8]= local[0];
149  if (local[1]!=local[8]) goto if71;
150  w = NIL;
151  vsp=local+8;
152  unwind(local+0);
153  local[0]=w;
154  goto blk65;
155  goto if72;
156 if71:
157  local[8]= NIL;
158 if72:
159  local[8]= local[0];
160  vsp=local+9;
161  w=(pointer)F58(1,local+8); /*newstr*/
162  local[8]= w;
163  local[9]= local[2];
164  vsp=local+10;
165  w=(pointer)PRINT(2,local+8); /*print*/
166  vsp=local+8;
167  goto tag70;
168  local[8]= NIL;
169 blk69:
170  w = local[8];
171  vsp=local+8;
172  uwp67(0,local+8,protfp->cleaner);
173  protfp=protfp->protlink;
174  vsp=local+5;
175  uwp66(0,local+5,protfp->cleaner);
176  protfp=protfp->protlink;
177  local[0]= w;
178 blk65:
179  vsp=local; return(local[0]);}
180 
181 /*closure or cleaner*/
182 static pointer uwp66(n,argv,env)
183 register int n; register pointer argv[]; pointer env;
184 { register pointer *local=vsp, w, *fqv=qv;
185  local[0]= env->c.clo.env2[2];
186  vsp=local+1;
187  w=(pointer)CLOSE(1,local+0); /*close*/
188  local[0]= w;
189  vsp=local; return(local[0]);}
190 
191 /*closure or cleaner*/
192 static pointer uwp67(n,argv,env)
193 register int n; register pointer argv[]; pointer env;
194 { register pointer *local=vsp, w, *fqv=qv;
195  local[0]= env->c.clo.env2[5];
196  vsp=local+1;
197  w=(pointer)CLOSE(1,local+0); /*close*/
198  local[0]= w;
199  vsp=local; return(local[0]);}
200 
201 /*allnewstrfile*/
202 static pointer F73(n,argv,env)
203 register int n; register pointer argv[]; pointer env;
204 { register pointer *local=vsp, w, *fqv=qv;
205  if (n!=1) maerror();
206  local[0]= NIL;
207  local[1]= argv[0];
208  vsp=local+2;
209  w=fcall(1,local+1,fqv[4]); /*directory*/
210  local[1]= w;
211 whl76:
212  if (local[1]==NIL) goto whx77;
213  local[2]= xcar(local[1]);
214  local[1] = xcdr(local[1]);
215  w = local[2];
216  local[0] = w;
217  local[2]= fqv[5];
218  local[3]= local[0];
219  vsp=local+4;
220  w=fcall(2,local+2,fqv[6]); /*substringp*/
221  if (w==NIL) goto if80;
222  local[2]= fqv[7];
223  vsp=local+3;
224  w=(pointer)UNLINK(1,local+2); /*unix:unlink*/
225  local[2]= local[0];
226  local[3]= fqv[8];
227  vsp=local+4;
228  w=(pointer)F64(2,local+2); /*newstrfile*/
229  local[2]= local[0];
230  vsp=local+3;
231  w=(pointer)UNLINK(1,local+2); /*unix:unlink*/
232  local[2]= NIL;
233  local[3]= fqv[9];
234  local[4]= local[0];
235  vsp=local+5;
236  w=(pointer)XFORMAT(3,local+2); /*format*/
237  local[2]= w;
238  vsp=local+3;
239  w=(pointer)SYSTEM(1,local+2); /*unix:system*/
240  local[2]= w;
241  goto if81;
242 if80:
243  local[2]= NIL;
244 if81:
245  goto whl76;
246 whx77:
247  local[2]= NIL;
248 blk78:
249  w = NIL;
250  local[0]= w;
251 blk74:
252  vsp=local; return(local[0]);}
253 
254 /* initializers*/
255 pointer eusmain(mod)
256 pointer mod;
257 { register pointer *local=vsp, w, *fqv; pointer *argv;
258  module=mod; quotevec=mod->c.code.quotevec;
259  codevec=mod->c.code.codevec;
260  fqv=qv=quotevec->c.vec.v;
261  vsp=local+0;
262  compfun(fqv[10],mod,F50,fqv[11]);
263  vsp=local+0;
264  compfun(fqv[12],mod,F58,fqv[11]);
265  vsp=local+0;
266  compfun(fqv[13],mod,F64,fqv[11]);
267  vsp=local+0;
268  compfun(fqv[14],mod,F73,fqv[11]);
269  local[0]= NIL;
270  vsp=local; return(local[0]);}
cell::cellunion::clo
struct closure clo
Definition: eus.h:411
closure::env2
pointer * env2
Definition: eus.h:271
qv
static pointer * qv
Definition: newstr.c:4
cell::cellunion::vec
struct vector vec
Definition: eus.h:414
LENGTH
pointer LENGTH(context *, int, pointer *)
makeint
#define makeint(v)
Definition: sfttest.c:2
pointer
struct cell * pointer
Definition: eus.h:165
cons
pointer cons(context *, pointer, pointer)
Definition: makes.c:97
cell::cellunion::str
struct string str
Definition: eus.h:402
string::chars
byte chars[1]
Definition: eus.h:212
makeclosure
pointer makeclosure(pointer, pointer, pointer(*)(), pointer, pointer *, pointer *)
Definition: makes.c:506
F58
static pointer F58(int n, argv, pointer env)
Definition: newstr.c:83
n
GLfloat n[6][3]
Definition: cube.c:15
cell::cellunion::code
struct code code
Definition: eus.h:408
intval
#define intval(p)
Definition: sfttest.c:1
SUBSEQ
pointer SUBSEQ(context *, int, pointer *)
xcar
pointer xcar(pointer p)
Definition: compsub.c:49
NUMEQUAL
pointer NUMEQUAL(context *ctx, int n, argv)
Definition: arith.c:36
code::codevec
pointer codevec
Definition: eus.h:231
maerror
int maerror()
Definition: compsub.c:14
cell::c
union cell::cellunion c
F50
static pointer F50(int n, argv, pointer env)
Definition: newstr.c:8
LESSP
pointer LESSP(context *ctx, int n, argv)
Definition: arith.c:168
uwp66
static pointer uwp66(int n, argv, pointer env)
Definition: newstr.c:182
uwp67
static pointer uwp67(int n, argv, pointer env)
Definition: newstr.c:192
cell
Definition: eus.h:381
eusmain
pointer eusmain(pointer mod)
Definition: newstr.c:255
quotevec
static pointer quotevec
Definition: newstr.c:4
fcall
pointer fcall()
SYSTEM
pointer SYSTEM(context *, int, pointer *)
UNLINK
pointer UNLINK(context *, int, pointer *)
code::quotevec
pointer quotevec
Definition: eus.h:232
XFORMAT
pointer XFORMAT(context *, int, pointer *)
unwind
void unwind(context *ctx, pointer *p)
Definition: eus.c:274
module
static pointer module
Definition: newstr.c:4
CLOSE
pointer CLOSE(context *, int, pointer *)
READ
pointer READ(context *, int, pointer *)
PRINT
pointer PRINT(context *, int, pointer *)
v
GLfloat v[8][3]
Definition: cube.c:21
GENSYM
pointer GENSYM(context *, int, pointer *)
xcdr
pointer xcdr(pointer p)
Definition: compsub.c:55
loadglobal
pointer loadglobal()
NIL
pointer NIL
Definition: eus.c:110
vector::v
pointer v[1]
Definition: eus.h:301
codevec
static pointer codevec
Definition: newstr.c:4
F64
static pointer F64(int n, argv, pointer env)
Definition: newstr.c:117
F73
static pointer F73(int n, argv, pointer env)
Definition: newstr.c:202
storeglobal
pointer storeglobal()
compfun
pointer compfun(context *, pointer, pointer, pointer(*)(), pointer)
Definition: makes.c:746

euslisp
Author(s): Toshihiro Matsui
autogenerated on Mon Feb 28 2022 22:18:28