Mercurial > hg > jgplsrc

annotate io.c @ 0:e0bbaa717f41 draft default tip

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
lol J
author Jordi Gutiérrez Hermoso <jordigh@octave.org>
date Mon, 25 Nov 2013 11:56:30 -0500 (2013-11-25)
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
1 /* Copyright 1990-2011, Jsoftware Inc. All rights reserved. */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
2 /* License in license.txt. */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
3 /* */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
4 /* Input/Output */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
5
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
6 #ifdef _WIN32
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
7 #include <windows.h>
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
8 #include <winbase.h>
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
9 #else
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
10 #include <stdlib.h>
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
11 #include <stdio.h>
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
12 #include <sys/types.h>
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
13 #include <sys/stat.h>
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
14 #include <fcntl.h>
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
15 #include <sys/mman.h>
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
16 #define _stdcall
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
17 #endif
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
18
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
19 #include "j.h"
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
20 #include "d.h"
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
21
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
22 void jtwri(J jt,I type,C*p,I m,C*s){C buf[1024],*t=jt->outseq,*v=buf;I c,d,e,n;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
23 if(jt->tostdout){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
24 c=strlen(p); /* prompt */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
25 e=strlen(t); /* end-of-line */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
26 n=sizeof(buf)-(c+e+1); /* main text */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
27 d=m>n?n-3:m;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
28 memcpy(v,p,c); v+=c;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
29 memcpy(v,s,d); v+=d; if(m>n){memcpy(v,"...",3L); v+=3;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
30 memcpy(v,t,e); v+=e;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
31 *v=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
32 jsto(jt,type,buf);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
33 }}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
34
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
35 static void jtwrf(J jt,I n,C*v,F f){C*u,*x;I j=0,m;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
36 while(n>j){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
37 u=j+v;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
38 m=(x=memchr(u,CLF,n-j))?1+x-u:n-j;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
39 fwrite(u,sizeof(C),m,f);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
40 j+=m;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
41 }}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
42
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
43 A jtinpl(J jt,B b,I n,C*s){C c;I k=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
44 if(n&&(c=*(s+n-1),CLF==c||CCR==c))--n;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
45 ASSERT(!*jt->adbreak,EVINPRUPT);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
46 if(!b){ /* 1==b means literal input */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
47 if(n&&COFF==*(s+n-1))joff(zero);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
48 c=jt->bx[9]; if(c<0)DO(n, if(' '!=s[i]&&c!=s[i]){k=i; break;});
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
49 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
50 R str(n-k,s+k);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
51 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
52
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
53 static I advl(I j,I n,C*s){B b;C c,*v;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
54 v=j+s;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
55 DO(n-j, c=*v++; b=c==CCR; if(b||c==CLF)R j+1+i+(b&&CLF==*v););
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
56 R n;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
57 } /* advance one line on CR, CRLF, or LF */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
58
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
59 void breakclose(J jt);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
60
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
61 static C* nfeinput(J jt,C* s){A y;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
62 jt->breakignore=1;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
63 y=exec1(cstr(s));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
64 jt->breakignore=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
65 if(!y){breakclose(jt);exit(2);} /* J input verb failed */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
66 jtwri(jt,MTYOLOG,"",strlen(CAV(y)),CAV(y));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
67 return CAV(y); /* don't combine with previous line! CAV runs (x) 2 times! */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
68 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
69
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
70 A jtjgets(J jt,C*p){A y;B b;C*v;I j,k,m,n;UC*s;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
71 *jt->adbreak=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
72 if(b=1==*p)p=""; /* 1 means literal input */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
73 if(jt->dcs){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
74 ++jt->dcs->dcn; j=jt->dcs->dci;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
75 y=jt->dcs->dcy; n=AN(y); s=UAV(y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
76 RZ(j<n);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
77 jt->dcs->dcj=k=j;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
78 jt->dcs->dci=j=advl(j,n,s);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
79 m=j-k; if(m&&32>s[k+m-1])--m; if(m&&32>s[k+m-1])--m;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
80 jtwri(jt,MTYOLOG,p,m,k+s);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
81 R inpl(b,m,k+s);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
82 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
83 /* J calls for input in 3 cases:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
84 debug suspension for normal input
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
85 n : 0 input lines up to terminating )
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
86 1!:1[1 read from keyboard */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
87 showerr();
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
88 if(jt->nfe)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
89 v=nfeinput(jt,*p?"input_jfe_' '":"input_jfe_''");
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
90 else{
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
91 ASSERT(jt->sminput,EVBREAK);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
92 v=((inputtype)(jt->sminput))(jt,p);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
93 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
94 R inpl(b,(I)strlen(v),v);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
95 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
96
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
97 extern C breakdata;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
98
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
99 #if SYS&SYS_UNIX
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
100 void breakclose(J jt)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
101 {
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
102 if(jt->adbreak==&breakdata) return;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
103 munmap(jt->adbreak,1);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
104 jt->adbreak=&breakdata;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
105 close(jt->breakfh);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
106 jt->breakfh=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
107 unlink(jt->breakfn);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
108 *jt->breakfn=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
109 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
110 #else
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
111 void breakclose(J jt)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
112 {
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
113 if(jt->adbreak==&breakdata) return;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
114 UnmapViewOfFile(jt->adbreak);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
115 jt->adbreak=&breakdata;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
116 CloseHandle(jt->breakmh);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
117 jt->breakmh=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
118 CloseHandle(jt->breakfh);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
119 jt->breakfh=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
120 #if SY_WINCE
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
121 DeleteFile(tounibuf(jt->breakfn));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
122 #else
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
123 DeleteFile(jt->breakfn);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
124 #endif
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
125 *jt->breakfn=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
126 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
127 #endif
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
128
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
129 F1(jtjoff){I x;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
130 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
131 x=i0(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
132 breakclose(jt);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
133 if(jt->sesm)jsto(jt, MTYOEXIT,(C*)x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
134 exit((int)x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
135 R 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
136 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
137
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
138 #if (SYS & SYS_SESM)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
139
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
140 I jdo(J jt, C* lp){I e,old;A x;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
141 jt->jerr=0; jt->etxn=0; /* clear old errors */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
142 old=jt->tbase+jt->ttop;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
143 *jt->adbreak=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
144 x=inpl(0,(I)strlen(lp),lp);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
145 while(jt->iepdo&&jt->iep){jt->iepdo=0; immex(jt->iep); jt->jerr=0; tpop(old);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
146 if(!jt->jerr)immex(x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
147 e=jt->jerr;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
148 jt->jerr=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
149 if(e&&DBERRCAP==jt->db&&jt->dbtrap){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
150 jt->db=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
151 immex(jt->dbtrap);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
152 jt->jerr=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
153 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
154 while(jt->iepdo&&jt->iep){jt->iepdo=0; immex(jt->iep); jt->jerr=0; tpop(old);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
155 showerr();
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
156 spfree();
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
157 tpop(old);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
158 R e;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
159 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
160
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
161 #define SZINT ((I)sizeof(int))
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
162
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
163 DF1(jtwd){A z=0;C*p=0;D*pd;I e,*pi,t;V*sv;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
164 F1RANK(1,jtwd,self);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
165 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
166 ASSERT(2>AR(w),EVRANK);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
167 sv=VAV(self);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
168 t=i0(sv->g);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
169 if(t>=2000 && t<3000 && AN(w) && LIT!=AT(w) && C2T!=AT(w) && INT!=AT(w))
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
170 {
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
171 switch(AT(w))
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
172 {
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
173 case B01:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
174 RZ(w=vi(w));break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
175 case FL:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
176 pd=DAV(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
177 GA(w,INT,AN(w),AR(w),0);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
178 pi=AV(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
179 DO(AN(w),*pi++=(I)(jfloor(0.5+*pd++)););
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
180 break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
181 default:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
182 ASSERT(0,EVDOMAIN);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
183 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
184 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
185 // t is 11!:t and w is wd argument
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
186 e=jt->smdowd ? ((dowdtype)(jt->smdowd))(jt, (int)t, w, &z) : EVDOMAIN;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
187 if(!e) R mtm; // e==0 is MTM
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
188 if(e==-1) R z; // e---1 is zp
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
189 ASSERT(e<=0,e); // e>=0 is EVDOMAIN etc
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
190 RZ(z=df1(z,cut(ds(CBOX),num[-2]))); // e==-2 is lit pairs
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
191 R reshape(v2(AN(z)/2,2L),z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
192 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
193
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
194 C* getlocale(J jt){A y=locname(mtv); y=*AAV(y); R CAV(y);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
195
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
196 static char breaknone=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
197
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
198 B jtsesminit(J jt){jt->adbreak=&breakdata; R 1;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
199 #endif
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
200
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
201 int _stdcall JDo(J jt, char* lp){int r;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
202 r=(int)jdo(jt,lp);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
203 while(jt->nfe)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
204 r=(int)jdo(jt,nfeinput(jt,"input_jfe_' '"));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
205 R r;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
206 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
207
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
208 /* socket protocol CMDGET name */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
209 A _stdcall JGetA(J jt, I n, C* name){A x;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
210 jt->jerr=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
211 RZ(x=symbrdlock(nfs(n,name)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
212 ASSERT(!(FUNC&AT(x)),EVDOMAIN);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
213 R binrep1(x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
214 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
215
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
216 /* socket protocol CMDSET */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
217 I _stdcall JSetA(J jt,I n,C* name,I dlen,C* d){I old;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
218 jt->jerr=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
219 if(!vnm(n,name)) R EVILNAME;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
220 old=jt->tbase+jt->ttop;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
221 symbis(nfs(n,name),jtunbin(jt,str(dlen,d)),jt->global);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
222 tpop(old);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
223 R jt->jerr;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
224 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
225
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
226 /* set jclient callbacks */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
227 void _stdcall JSM(J jt, void* callbacks[])
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
228 {
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
229 jt->smoutput = (outputtype)callbacks[0];
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
230 jt->smdowd = (dowdtype)callbacks[1];
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
231 jt->sminput = (inputtype)callbacks[2];
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
232 jt->sm = (I)callbacks[4];
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
233 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
234
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
235 C* _stdcall JGetLocale(J jt){return getlocale(jt);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
236
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
237 A _stdcall Jga(J jt, I t, I n, I r, I*s){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
238 return ga(t, n, r, s);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
239 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
240
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
241 void oleoutput(J jt, I n, char* s); /* SY_WIN32 only */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
242
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
243 /* jsto - display output in output window */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
244 void jsto(J jt,I type,C*s){C e;I ex;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
245 if(jt->nfe)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
246 {
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
247 C q[]="0 output_jfe_ (15!:18)0";
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
248 q[0]+=(C)type;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
249 jt->mtyostr=s;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
250 e=jt->jerr; ex=jt->etxn;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
251 jt->jerr=0; jt->etxn=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
252 jt->breakignore=1;exec1(cstr(q));jt->breakignore=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
253 jt->jerr=e; jt->etxn=ex;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
254 }else{
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
255 if(jt->smoutput) ((outputtype)(jt->smoutput))(jt,(int)type,s);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
256 #if SY_WIN32 && !SY_WINCE
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
257 if(type & MTYOFM) oleoutput(jt,strlen(s),s); /* save output for ole */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
258 #endif
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
259 }}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
260
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
261 #if SYS&SYS_UNIX
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
262
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
263 J JInit(void){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
264 J jt;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
265 /* jtglobinit must be done once when dll is first loaded
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
266 Windows does it in dll load routine - thread safe
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
267 Unix does it here once, but this is not thread safe */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
268
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
269 static J g_jt=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
270 if(!g_jt)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
271 {
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
272 g_jt=malloc(sizeof(JST));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
273 if(!g_jt) R 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
274 memset(g_jt,0,sizeof(JST));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
275 if(!jtglobinit(g_jt)){free(g_jt);g_jt=0; R 0;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
276 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
277 RZ(jt=malloc(sizeof(JST)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
278 memset(jt,0,sizeof(JST));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
279 if(!jtjinit2(jt,0,0)){free(jt); R 0;};
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
280 R jt;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
281 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
282
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
283 int JFree(J jt){return 0;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
284 #endif
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
285
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
286 F1(jtbreakfnq){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
287 ASSERTMTV(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
288 R cstr(jt->breakfn);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
289 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
290
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
291 F1(jtbreakfns){A z;I *fh,*mh; void* ad;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
292 ASSERT(1>=AR(w),EVRANK);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
293 ASSERT(!AN(w)||AT(w)&LIT,EVDOMAIN);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
294 ASSERT(AN(w)<NPATH,EVDOMAIN);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
295 if(!strcmp(jt->breakfn,CAV(w))) R mtm;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
296 breakclose(jt);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
297 #if SYS&SYS_UNIX
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
298 fh=(I*)(I)open(CAV(w),O_RDWR);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
299 ASSERT(-1!=(I)fh,EVDOMAIN);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
300 ad=mmap(0,1,PROT_READ|PROT_WRITE,MAP_SHARED,(I)fh,0);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
301 if(0==ad){close(fh); ASSERT(0,EVDOMAIN);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
302 #else
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
303 RZ(z=toutf16x(w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
304 fh=CreateFileW(USAV(z),GENERIC_READ|GENERIC_WRITE,FILE_SHARE_READ|FILE_SHARE_WRITE,0,OPEN_EXISTING,0,0);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
305 ASSERT(INVALID_HANDLE_VALUE!=fh,EVDOMAIN);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
306 mh=CreateFileMapping(fh,0,PAGE_READWRITE,0,1,0);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
307 if(0==mh){CloseHandle(fh); ASSERT(0,EVDOMAIN);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
308 ad=MapViewOfFile(mh,FILE_MAP_WRITE,0,0,0);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
309 if(0==ad){CloseHandle(mh); CloseHandle(fh); ASSERT(0,EVDOMAIN);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
310 #endif
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
311 strcpy(jt->breakfn,CAV(w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
312 jt->breakfh=fh;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
313 jt->breakmh=mh;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
314 jt->adbreak=ad;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
315 R mtm;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
316 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
317
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
318 int valid(C* psrc, C* psnk)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
319 {
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
320 while(*psrc == ' ') ++psrc;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
321 if(!isalpha(*psrc)) return EVILNAME;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
322 while(isalnum(*psrc) || *psrc=='_') *psnk++ = *psrc++;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
323 while(*psrc == ' ') ++psrc;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
324 if(*psrc) return EVILNAME;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
325 *psnk = 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
326 return 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
327 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
328
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
329 int _stdcall JGetM(J jt, C* name, I* jtype, I* jrank, I* jshape, I* jdata)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
330 {
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
331 A a; char gn[256];
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
332 if(strlen(name) >= sizeof(gn)) return EVILNAME;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
333 if(valid(name, gn)) return EVILNAME;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
334 RZ(a=symbrdlock(nfs(strlen(gn),gn)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
335 if(FUNC&AT(a))R EVDOMAIN;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
336 *jtype = AT(a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
337 *jrank = AR(a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
338 *jshape = (I)AS(a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
339 *jdata = (I)AV(a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
340 return 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
341 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
342
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
343 static int setterm(J jt, C* name, I* jtype, I* jrank, I* jshape, I* jdata)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
344 {
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
345 A a;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
346 I k=1,i,n;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
347 char gn[256];
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
348
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
349 switch(*jtype)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
350 {
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
351 case LIT:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
352 case B01:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
353 n = sizeof(char);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
354 break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
355
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
356 case INT:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
357 n = sizeof(I);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
358 break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
359
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
360 case FL:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
361 n = sizeof(double);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
362 break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
363
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
364 case CMPX:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
365 n = 2 * sizeof(double);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
366 break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
367
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
368 default:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
369 return EVDOMAIN;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
370 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
371
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
372 // validate name
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
373 if(strlen(name) >= sizeof(gn)) return EVILNAME;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
374 if(valid(name, gn)) return EVILNAME;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
375 for(i=0; i<*jrank; ++i) k *= ((I*)(*jshape))[i];
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
376 a = ga(*jtype, k, *jrank, (I*)*jshape);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
377 if(!a) return EVWSFULL;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
378 memcpy(AV(a), (void*)*jdata, n*k);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
379 jset(gn, a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
380 return jt->jerr;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
381 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
382
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
383 int _stdcall JSetM(J jt, C* name, I* jtype, I* jrank, I* jshape, I* jdata)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
384 {
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
385 int er;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
386
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
387 PROLOG;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
388 er = setterm(jt, name, jtype, jrank, jshape, jdata);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
389 tpop(_ttop);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
390 return er;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
391 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
392
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
393 #define EDCBUSY -1
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
394 #define EDCEXE -2
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
395
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
396 C* esub(J jt, I ec)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
397 {
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
398 if(!ec) return "";
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
399 if(ec == EDCBUSY) return "busy with previous input";
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
400 if(ec == EDCEXE) return "not supported in EXE server";
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
401 if(ec > NEVM || ec < 0) return "unknown error";
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
402 return (C*)AV(*(ec+AAV(jt->evm)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
403 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
404
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
405 int _stdcall JErrorTextM(J jt, I ec, I* p)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
406 {
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
407 *p = (I)esub(jt, ec);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
408 return 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
409 }