1 /* -*- tab-width: 4 -*-
2 *
3 * Electric(tm) VLSI Design System
4 *
5 * File: dblangelk.c
6 * ELK Lisp interface module
7 * Written by: Steven M. Rubin, Static Free Software
8 *
9 * Copyright (c) 2000 Static Free Software.
10 *
11 * Electric(tm) is free software; you can redistribute it and/or modify
12 * it under the terms of the GNU General Public License as published by
13 * the Free Software Foundation; either version 2 of the License, or
14 * (at your option) any later version.
15 *
16 * Electric(tm) is distributed in the hope that it will be useful,
17 * but WITHOUT ANY WARRANTY; without even the implied warranty of
18 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 * GNU General Public License for more details.
20 *
21 * You should have received a copy of the GNU General Public License
22 * along with Electric(tm); see the file COPYING. If not, write to
23 * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
24 * Boston, Mass 02111-1307, USA.
25 *
26 * Static Free Software
27 * 4119 Alpine Road
28 * Portola Valley, California 94028
29 * info@staticfreesoft.com
30 */
31
32 #include "config.h"
33 #if LANGLISP
34
35 #include "global.h"
36 #include "dblang.h"
37
38 static ELKObject lsp_displayablesym;
39 static BOOLEAN lsp_strportinited = FALSE;
40 static ELKObject lsp_strport;
41
42 #define Ensure_Type(x,t) if (TYPE(x) != t) { Wrong_Type(x, t); return(Null); }
43
44 /* prototypes for local routines */
45 static int EElectric_Equal(ELKObject, ELKObject);
46 static int ENodeInst_Print(ELKObject, ELKObject, int, int, int);
47 static int ENodeProto_Print(ELKObject, ELKObject, int, int, int);
48 static int EPortArcInst_Print(ELKObject, ELKObject, int, int, int);
49 static int EPortExpInst_Print(ELKObject, ELKObject, int, int, int);
50 static int EPortProto_Print(ELKObject, ELKObject, int, int, int);
51 static int EArcInst_Print(ELKObject, ELKObject, int, int, int);
52 static int EArcProto_Print(ELKObject, ELKObject, int, int, int);
53 static int EGeom_Print(ELKObject, ELKObject, int, int, int);
54 static int ELibrary_Print(ELKObject, ELKObject, int, int, int);
55 static int ETechnology_Print(ELKObject, ELKObject, int, int, int);
56 static int ETool_Print(ELKObject, ELKObject, int, int, int);
57 static int ERTNode_Print(ELKObject, ELKObject, int, int, int);
58 static int ENetwork_Print(ELKObject, ELKObject, int, int, int);
59 static int EView_Print(ELKObject, ELKObject, int, int, int);
60 static int EWindow_Print(ELKObject, ELKObject, int, int, int);
61 static int EGraphics_Print(ELKObject, ELKObject, int, int, int);
62 static int EConstraint_Print(ELKObject, ELKObject, int, int, int);
63 static int EWindowFrame_Print(ELKObject, ELKObject, int, int, int);
64 static ELKObject P_ENodeInstP(ELKObject);
65 static ELKObject P_ENodeProtoP(ELKObject);
66 static ELKObject P_EPortArcInstP(ELKObject);
67 static ELKObject P_EPortExpInstP(ELKObject);
68 static ELKObject P_EPortProtoP(ELKObject);
69 static ELKObject P_EArcInstP(ELKObject);
70 static ELKObject P_EArcProtoP(ELKObject);
71 static ELKObject P_EGeomP(ELKObject);
72 static ELKObject P_ELibraryP(ELKObject);
73 static ELKObject P_ETechnologyP(ELKObject);
74 static ELKObject P_EToolP(ELKObject);
75 static ELKObject P_ERTNodeP(ELKObject);
76 static ELKObject P_ENetworkP(ELKObject);
77 static ELKObject P_EViewP(ELKObject);
78 static ELKObject P_EWindowP(ELKObject);
79 static ELKObject P_EGraphicsP(ELKObject);
80 static ELKObject P_EConstraintP(ELKObject);
81 static ELKObject P_EWindowFrameP(ELKObject);
82 static ELKObject Make_EElectric(INTBIG, INTBIG);
83 static void init_lib_electric(void);
84 static BOOLEAN lsp_getnumericobject(ELKObject, INTBIG*);
85 static CHAR *lsp_getstringobject(ELKObject);
86 static void lsp_getaddrandtype(ELKObject, INTBIG*, INTBIG*);
87 static ELKObject lsp_makevarobject(INTBIG, INTBIG);
88 static ELKObject lsp_curlib(void);
89 static ELKObject lsp_curtech(void);
90 static ELKObject lsp_getval(ELKObject, ELKObject);
91 static ELKObject lsp_getparentval(ELKObject, ELKObject, ELKObject);
92 static ELKObject lsp_dogetparentval(CHAR*, ELKObject, INTBIG);
93 static ELKObject lsp_P(ELKObject oname);
94 static ELKObject lsp_PD(ELKObject oname, ELKObject odefault);
95 static ELKObject lsp_PAR(ELKObject oname);
96 static ELKObject lsp_PARD(ELKObject oname, ELKObject odefault);
97 static ELKObject lsp_setval(ELKObject, ELKObject, ELKObject, ELKObject);
98 static ELKObject lsp_setind(ELKObject, ELKObject, ELKObject, ELKObject);
99 static ELKObject lsp_delval(ELKObject, ELKObject);
100 static ELKObject lsp_initsearch(ELKObject, ELKObject, ELKObject, ELKObject, ELKObject);
101 static ELKObject lsp_nextobject(ELKObject);
102 static ELKObject lsp_gettool(ELKObject);
103 static ELKObject lsp_maxtool(void);
104 static ELKObject lsp_indextool(ELKObject);
105 static ELKObject lsp_toolturnon(ELKObject);
106 static ELKObject lsp_toolturnoff(ELKObject);
107 static ELKObject lsp_getlibrary(ELKObject);
108 static ELKObject lsp_newlibrary(ELKObject, ELKObject);
109 static ELKObject lsp_killlibrary(ELKObject);
110 static ELKObject lsp_eraselibrary(ELKObject);
111 static ELKObject lsp_selectlibrary(ELKObject);
112 static ELKObject lsp_getnodeproto(ELKObject);
113 static ELKObject lsp_newnodeproto(ELKObject, ELKObject);
114 static ELKObject lsp_killnodeproto(ELKObject);
115 static ELKObject lsp_copynodeproto(ELKObject, ELKObject, ELKObject);
116 static ELKObject lsp_iconview(ELKObject);
117 static ELKObject lsp_contentsview(ELKObject);
118 static ELKObject lsp_newnodeinst(ELKObject, ELKObject, ELKObject, ELKObject, ELKObject, ELKObject, ELKObject, ELKObject);
119 static ELKObject lsp_modifynodeinst(ELKObject, ELKObject, ELKObject, ELKObject, ELKObject, ELKObject, ELKObject);
120 static ELKObject lsp_killnodeinst(ELKObject);
121 static ELKObject lsp_replacenodeinst(ELKObject, ELKObject);
122 static ELKObject lsp_nodefunction(ELKObject);
123 static ELKObject lsp_newarcinst(ELKObject, ELKObject, ELKObject, ELKObject, ELKObject, ELKObject, ELKObject, ELKObject,
124 ELKObject, ELKObject, ELKObject, ELKObject);
125 static ELKObject lsp_modifyarcinst(ELKObject, ELKObject, ELKObject, ELKObject, ELKObject, ELKObject);
126 static ELKObject lsp_killarcinst(ELKObject);
127 static ELKObject lsp_replacearcinst(ELKObject, ELKObject);
128 static ELKObject lsp_newportproto(ELKObject, ELKObject, ELKObject, ELKObject);
129 static ELKObject lsp_portposition(ELKObject, ELKObject);
130 static ELKObject lsp_getportproto(ELKObject, ELKObject);
131 static ELKObject lsp_killportproto(ELKObject, ELKObject);
132 static ELKObject lsp_moveportproto(ELKObject, ELKObject, ELKObject, ELKObject);
133 static ELKObject lsp_undoabatch(void);
134 static ELKObject lsp_noundoallowed(void);
135 static ELKObject lsp_getview(ELKObject);
136 static ELKObject lsp_newview(ELKObject, ELKObject);
137 static ELKObject lsp_killview(ELKObject);
138 static ELKObject lsp_telltool(long, ELKObject[]);
139 static ELKObject lsp_getarcproto(ELKObject);
140 static ELKObject lsp_gettechnology(ELKObject);
141 static ELKObject lsp_getpinproto(ELKObject);
142 static ELKObject lsp_getnetwork(ELKObject, ELKObject);
143
144 /****************************** ELECTRIC OBJECTS ******************************/
145
146 /* the internal LISP types */
147 static long T_ENodeInst, T_ENodeProto, T_EPortArcInst, T_EPortExpInst, T_EPortProto,
148 T_EArcInst, T_EArcProto, T_EGeom, T_ELibrary, T_ETechnology, T_ETool,
149 T_ERTNode, T_ENetwork, T_EView, T_EWindow, T_EGraphics, T_EConstraint,
150 T_EWindowFrame;
151
152 /* the LISP structures */
153 struct S_Electric { INTBIG handle; };
154 struct S_ENodeInst { NODEINST *handle; };
155 struct S_ENodeProto { NODEPROTO *handle; };
156 struct S_EPortArcInst { PORTARCINST *handle; };
157 struct S_EPortExpInst { PORTEXPINST *handle; };
158 struct S_EPortProto { PORTPROTO *handle; };
159 struct S_EArcInst { ARCINST *handle; };
160 struct S_EArcProto { ARCPROTO *handle; };
161 struct S_EGeom { GEOM *handle; };
162 struct S_ELibrary { LIBRARY *handle; };
163 struct S_ETechnology { TECHNOLOGY *handle; };
164 struct S_ETool { TOOL *handle; };
165 struct S_ERTNode { RTNODE *handle; };
166 struct S_ENetwork { NETWORK *handle; };
167 struct S_EView { VIEW *handle; };
168 struct S_EWindow { WINDOWPART *handle; };
169 struct S_EGraphics { GRAPHICS *handle; };
170 struct S_EConstraint { CONSTRAINT *handle; };
171 struct S_EWindowFrame { WINDOWFRAME *handle; };
172
173 /* macros for accessing Electric objects from the Lisp structures */
174 #define EELECTRIC(obj) ((struct S_Electric *)POINTER(obj))
175 #define ENODEINST(obj) ((struct S_ENodeInst *)POINTER(obj))
176 #define ENODEPROTO(obj) ((struct S_ENodeProto *)POINTER(obj))
177 #define EPORTARCINST(obj) ((struct S_EPortArcInst *)POINTER(obj))
178 #define EPORTEXPINST(obj) ((struct S_EPortExpInst *)POINTER(obj))
179 #define EPORTPROTO(obj) ((struct S_EPortProto *)POINTER(obj))
180 #define EARCINST(obj) ((struct S_EArcInst *)POINTER(obj))
181 #define EARCPROTO(obj) ((struct S_EArcProto *)POINTER(obj))
182 #define EGEOM(obj) ((struct S_EGeom *)POINTER(obj))
183 #define ELIBRARY(obj) ((struct S_ELibrary *)POINTER(obj))
184 #define ETECHNOLOGY(obj) ((struct S_ETechnology *)POINTER(obj))
185 #define ETOOL(obj) ((struct S_ETool *)POINTER(obj))
186 #define ERTNODE(obj) ((struct S_ERTNode *)POINTER(obj))
187 #define ENETWORK(obj) ((struct S_ENetwork *)POINTER(obj))
188 #define EVIEW(obj) ((struct S_EView *)POINTER(obj))
189 #define EWINDOW(obj) ((struct S_EWindow *)POINTER(obj))
190 #define EGRAPHICS(obj) ((struct S_EGraphics *)POINTER(obj))
191 #define ECONSTRAINT(obj) ((struct S_EConstraint *)POINTER(obj))
192 #define EWINDOWFRAME(obj) ((struct S_EWindowFrame *)POINTER(obj))
193
194 /* equality routine */
EElectric_Equal(ELKObject a,ELKObject b)195 int EElectric_Equal(ELKObject a, ELKObject b)
196 {
197 return(EELECTRIC(a)->handle == EELECTRIC(b)->handle);
198 }
199
200 /* print routines */
ENodeInst_Print(ELKObject w,ELKObject port,int raw,int depth,int len)201 int ENodeInst_Print(ELKObject w, ELKObject port, int raw, int depth, int len)
202 { Printf(port, x_("#[nodeinst %u]"), ENODEINST(w)->handle); return(0); }
ENodeProto_Print(ELKObject w,ELKObject port,int raw,int depth,int len)203 int ENodeProto_Print(ELKObject w, ELKObject port, int raw, int depth, int len)
204 { Printf(port, x_("#[nodeproto %s]"), describenodeproto(ENODEPROTO(w)->handle)); return(0); }
EPortArcInst_Print(ELKObject w,ELKObject port,int raw,int depth,int len)205 int EPortArcInst_Print(ELKObject w, ELKObject port, int raw, int depth, int len)
206 { Printf(port, x_("#[portarcinst %u]"), EPORTARCINST(w)->handle); return(0); }
EPortExpInst_Print(ELKObject w,ELKObject port,int raw,int depth,int len)207 int EPortExpInst_Print(ELKObject w, ELKObject port, int raw, int depth, int len)
208 { Printf(port, x_("#[portexpinst %u]"), EPORTEXPINST(w)->handle); return(0); }
EPortProto_Print(ELKObject w,ELKObject port,int raw,int depth,int len)209 int EPortProto_Print(ELKObject w, ELKObject port, int raw, int depth, int len)
210 { Printf(port, x_("#[portproto %s]"), EPORTPROTO(w)->handle->protoname); return(0); }
EArcInst_Print(ELKObject w,ELKObject port,int raw,int depth,int len)211 int EArcInst_Print(ELKObject w, ELKObject port, int raw, int depth, int len)
212 { Printf(port, x_("#[arcinst %u]"), EARCINST(w)->handle); return(0); }
EArcProto_Print(ELKObject w,ELKObject port,int raw,int depth,int len)213 int EArcProto_Print(ELKObject w, ELKObject port, int raw, int depth, int len)
214 { Printf(port, x_("#[arcproto %s]"), EARCPROTO(w)->handle->protoname); return(0); }
EGeom_Print(ELKObject w,ELKObject port,int raw,int depth,int len)215 int EGeom_Print(ELKObject w, ELKObject port, int raw, int depth, int len)
216 { Printf(port, x_("#[geom %u]"), EGEOM(w)->handle); return(0); }
ELibrary_Print(ELKObject w,ELKObject port,int raw,int depth,int len)217 int ELibrary_Print(ELKObject w, ELKObject port, int raw, int depth, int len)
218 { Printf(port, x_("#[library %s]"), ELIBRARY(w)->handle->libname); return(0); }
ETechnology_Print(ELKObject w,ELKObject port,int raw,int depth,int len)219 int ETechnology_Print(ELKObject w, ELKObject port, int raw, int depth, int len)
220 { Printf(port, x_("#[technology %s]"), ETECHNOLOGY(w)->handle->techname); return(0); }
ETool_Print(ELKObject w,ELKObject port,int raw,int depth,int len)221 int ETool_Print(ELKObject w, ELKObject port, int raw, int depth, int len)
222 { Printf(port, x_("#[tool %s]"), ETOOL(w)->handle->toolname); return(0); }
ERTNode_Print(ELKObject w,ELKObject port,int raw,int depth,int len)223 int ERTNode_Print(ELKObject w, ELKObject port, int raw, int depth, int len)
224 { Printf(port, x_("#[r-tree %u]"), ERTNODE(w)->handle); return(0); }
ENetwork_Print(ELKObject w,ELKObject port,int raw,int depth,int len)225 int ENetwork_Print(ELKObject w, ELKObject port, int raw, int depth, int len)
226 { Printf(port, x_("#[network %u]"), ENETWORK(w)->handle); return(0); }
EView_Print(ELKObject w,ELKObject port,int raw,int depth,int len)227 int EView_Print(ELKObject w, ELKObject port, int raw, int depth, int len)
228 { Printf(port, x_("#[view %s]"), EVIEW(w)->handle->viewname); return(0); }
EWindow_Print(ELKObject w,ELKObject port,int raw,int depth,int len)229 int EWindow_Print(ELKObject w, ELKObject port, int raw, int depth, int len)
230 { Printf(port, x_("#[window %u]"), EWINDOW(w)->handle); return(0); }
EGraphics_Print(ELKObject w,ELKObject port,int raw,int depth,int len)231 int EGraphics_Print(ELKObject w, ELKObject port, int raw, int depth, int len)
232 { Printf(port, x_("#[graphics %u]"), EGRAPHICS(w)->handle); return(0); }
EConstraint_Print(ELKObject w,ELKObject port,int raw,int depth,int len)233 int EConstraint_Print(ELKObject w, ELKObject port, int raw, int depth, int len)
234 { Printf(port, x_("#[constraint %s]"), ECONSTRAINT(w)->handle->conname); return(0); }
EWindowFrame_Print(ELKObject w,ELKObject port,int raw,int depth,int len)235 int EWindowFrame_Print(ELKObject w, ELKObject port, int raw, int depth, int len)
236 { Printf(port, x_("#[window-frame %u]"), EWINDOWFRAME(w)->handle); return(0); }
237
238 /* type query routines */
P_ENodeInstP(ELKObject x)239 ELKObject P_ENodeInstP(ELKObject x) { return(TYPE(x) == T_ENodeInst ? Trueob : Falseob); }
P_ENodeProtoP(ELKObject x)240 ELKObject P_ENodeProtoP(ELKObject x) { return(TYPE(x) == T_ENodeProto ? Trueob : Falseob); }
P_EPortArcInstP(ELKObject x)241 ELKObject P_EPortArcInstP(ELKObject x) { return(TYPE(x) == T_EPortArcInst ? Trueob : Falseob); }
P_EPortExpInstP(ELKObject x)242 ELKObject P_EPortExpInstP(ELKObject x) { return(TYPE(x) == T_EPortExpInst ? Trueob : Falseob); }
P_EPortProtoP(ELKObject x)243 ELKObject P_EPortProtoP(ELKObject x) { return(TYPE(x) == T_EPortProto ? Trueob : Falseob); }
P_EArcInstP(ELKObject x)244 ELKObject P_EArcInstP(ELKObject x) { return(TYPE(x) == T_EArcInst ? Trueob : Falseob); }
P_EArcProtoP(ELKObject x)245 ELKObject P_EArcProtoP(ELKObject x) { return(TYPE(x) == T_EArcProto ? Trueob : Falseob); }
P_EGeomP(ELKObject x)246 ELKObject P_EGeomP(ELKObject x) { return(TYPE(x) == T_EGeom ? Trueob : Falseob); }
P_ELibraryP(ELKObject x)247 ELKObject P_ELibraryP(ELKObject x) { return(TYPE(x) == T_ELibrary ? Trueob : Falseob); }
P_ETechnologyP(ELKObject x)248 ELKObject P_ETechnologyP(ELKObject x) { return(TYPE(x) == T_ETechnology ? Trueob : Falseob); }
P_EToolP(ELKObject x)249 ELKObject P_EToolP(ELKObject x) { return(TYPE(x) == T_ETool ? Trueob : Falseob); }
P_ERTNodeP(ELKObject x)250 ELKObject P_ERTNodeP(ELKObject x) { return(TYPE(x) == T_ERTNode ? Trueob : Falseob); }
P_ENetworkP(ELKObject x)251 ELKObject P_ENetworkP(ELKObject x) { return(TYPE(x) == T_ENetwork ? Trueob : Falseob); }
P_EViewP(ELKObject x)252 ELKObject P_EViewP(ELKObject x) { return(TYPE(x) == T_EView ? Trueob : Falseob); }
P_EWindowP(ELKObject x)253 ELKObject P_EWindowP(ELKObject x) { return(TYPE(x) == T_EWindow ? Trueob : Falseob); }
P_EGraphicsP(ELKObject x)254 ELKObject P_EGraphicsP(ELKObject x) { return(TYPE(x) == T_EGraphics ? Trueob : Falseob); }
P_EConstraintP(ELKObject x)255 ELKObject P_EConstraintP(ELKObject x) { return(TYPE(x) == T_EConstraint ? Trueob : Falseob); }
P_EWindowFrameP(ELKObject x)256 ELKObject P_EWindowFrameP(ELKObject x) { return(TYPE(x) == T_EWindowFrame ? Trueob : Falseob); }
257
Make_EElectric(INTBIG obj,INTBIG type)258 ELKObject Make_EElectric(INTBIG obj, INTBIG type)
259 {
260 CHAR *p;
261 ELKObject w;
262
263 p = (CHAR *)emalloc(sizeof (struct S_Electric), el_tempcluster);
264 SET(w, type, p);
265 EELECTRIC(w)->handle = obj;
266 return(w);
267 }
268
269 /****************************** UTILITIES ******************************/
270
lsp_init(void)271 void lsp_init(void)
272 {
273 CHAR *av[1], progname[30];
274
275 if (lsp_strportinited) return;
276 lsp_strportinited = TRUE;
277
278 /* initialize Lisp (must do it this way to give it stack base info) */
279 estrcpy(progname, x_("electric"));
280 av[0] = progname;
281 Elk_Init (1, av, 0, x_("toplevel.scm"));
282 init_lib_electric();
283
284 /* load the top-level interpreter */
285 /* (void)General_Load(Make_String("toplevel.scm", 12), The_Environment); */
286
287 /* create the dummy string port */
288 lsp_strport = Make_Port(0, (FILE *)0, Make_String ((CHAR *)0, 0));
289 Global_GC_Link(lsp_strport);
290 }
291
292 /*
293 * routine to convert a "C" string into a lisp ELKObject
294 */
lsp_makeobject(CHAR * str)295 ELKObject lsp_makeobject(CHAR *str)
296 {
297 ELKObject ret;
298 REGISTER int c, konst = 1;
299 ELKObject Read_Sequence (ELKObject port, int vec, int konst);
300 ELKObject Read_Atom (ELKObject port, int konst);
301 int String_Getc(ELKObject port);
302 int Skip_Comment(ELKObject port);
303 int String_Ungetc(ELKObject port, int c);
304
305 /* place the string in the port */
306 PORT(lsp_strport)->ptr = 0;
307 PORT(lsp_strport)->name = Make_String(str, estrlen(str));
308 PORT(lsp_strport)->flags = P_STRING|P_INPUT|P_OPEN;
309
310 /* read from the string port into an object */
311 ret = Eof;
312 for(;;)
313 {
314 c = String_Getc(lsp_strport);
315 if (c == EOF) break;
316 if (Whitespace(c)) continue;
317 if (c == ';')
318 {
319 if (Skip_Comment(lsp_strport) == EOF) break;
320 continue;
321 }
322 if (c == '(')
323 {
324 ret = Read_Sequence(lsp_strport, 0, konst);
325 } else
326 {
327 String_Ungetc(lsp_strport, c);
328 ret = Read_Atom(lsp_strport, konst);
329 }
330 break;
331 }
332
333 /* free the string pointer */
334 PORT(lsp_strport)->name = Null;
335 return(ret);
336 }
337
338 /*
339 * routine to convert Lisp ELKObject "obj" into an Electric address of type "type" and return
340 * it in "retval". Returns true on error.
341 */
lsp_describeobject(ELKObject obj,INTBIG type,INTBIG * retval)342 BOOLEAN lsp_describeobject(ELKObject obj, INTBIG type, INTBIG *retval)
343 {
344 static CHAR retstr[100];
345 static INTBIG retarray[1];
346 INTBIG len;
347 INTBIG t;
348 ELKObject strobj;
349 CHAR *str, *p;
350
351 t = TYPE(obj);
352 switch (type&VTYPE)
353 {
354 case VINTEGER:
355 case VSHORT:
356 case VBOOLEAN:
357 case VADDRESS:
358 case VFRACT:
359 switch (t)
360 {
361 case T_Fixnum:
362 case T_Boolean:
363 *retval = FIXNUM(obj);
364 break;
365 case T_Bignum:
366 PORT(lsp_strport)->ptr = 0;
367 PORT(lsp_strport)->name = Make_String(0, 0);
368 PORT(lsp_strport)->flags = P_STRING|P_OPEN;
369 Print_Bignum(lsp_strport, obj);
370 strobj = PORT(lsp_strport)->name;
371 str = STRING(strobj)->data;
372 len = PORT(lsp_strport)->ptr;
373 (void)estrncpy(retstr, str, len);
374 retstr[len] = 0;
375 *retval = myatoi(retstr);
376 break;
377 case T_Flonum:
378 *retval = (INTBIG)FLONUM(obj)->val;
379 break;
380 default:
381 return(TRUE);
382 }
383 if ((type&VTYPE) == VFRACT) *retval *= WHOLE;
384 break;
385
386 case VFLOAT:
387 case VDOUBLE:
388 switch (t)
389 {
390 case T_Fixnum:
391 case T_Boolean:
392 *retval = castint((float)FIXNUM(obj));
393 break;
394 case T_Bignum:
395 PORT(lsp_strport)->ptr = 0;
396 PORT(lsp_strport)->name = Make_String(0, 0);
397 PORT(lsp_strport)->flags = P_STRING|P_OPEN;
398 Print_Bignum(lsp_strport, obj);
399 strobj = PORT(lsp_strport)->name;
400 str = STRING(strobj)->data;
401 len = PORT(lsp_strport)->ptr;
402 (void)estrncpy(retstr, str, len);
403 retstr[len] = 0;
404 *retval = castint((float)eatof(retstr));
405 break;
406 case T_Flonum:
407 *retval = castint((float)FLONUM(obj)->val);
408 break;
409 default:
410 return(TRUE);
411 }
412 break;
413
414 case VCHAR:
415 if (t != T_Character) return(TRUE);
416 *retval = ELKCHAR(obj);
417 break;
418
419 case VSTRING:
420 *retval = (INTBIG)x_("");
421 switch (t)
422 {
423 case T_Null:
424 *retval = (INTBIG)x_("()");
425 break;
426 case T_Fixnum:
427 (void)esnprintf(retstr, 100, x_("%d"), (int)FIXNUM(obj));
428 *retval = (INTBIG)retstr;
429 break;
430 case T_Bignum:
431 PORT(lsp_strport)->ptr = 0;
432 PORT(lsp_strport)->name = Make_String(0, 0);
433 PORT(lsp_strport)->flags = P_STRING|P_OPEN;
434 Print_Bignum(lsp_strport, obj);
435 strobj = PORT(lsp_strport)->name;
436 str = STRING(strobj)->data;
437 len = PORT(lsp_strport)->ptr;
438 (void)estrncpy(retstr, str, len);
439 retstr[len] = 0;
440 *retval = (INTBIG)retstr;
441 break;
442 case T_Flonum:
443 (void)esnprintf(retstr, 100, x_("%g"), FLONUM(obj)->val);
444 *retval = (INTBIG)retstr;
445 break;
446 case T_Boolean:
447 if (FIXNUM(obj) != 0) *retval = (INTBIG)x_("t"); else
448 *retval = (INTBIG)x_("f");
449 break;
450 case T_Unbound:
451 *retval = (INTBIG)x_("#[unbound]");
452 break;
453 case T_Special:
454 *retval = (INTBIG)x_("#[special]");
455 break;
456 case T_Character:
457 retstr[0] = ELKCHAR(obj);
458 retstr[1] = 0;
459 *retval = (INTBIG)retstr;
460 break;
461 case T_Symbol:
462 strobj = SYMBOL(obj)->name;
463 str = STRING(strobj)->data;
464 len = STRING(strobj)->size;
465 (void)estrncpy(retstr, str, len);
466 retstr[len] = 0;
467 *retval = (INTBIG)retstr;
468 break;
469 case T_Pair:
470 PORT(lsp_strport)->ptr = 0;
471 PORT(lsp_strport)->name = Make_String(0, 0);
472 PORT(lsp_strport)->flags = P_STRING|P_OPEN;
473 Pr_List(lsp_strport, obj, 1, DEF_PRINT_DEPTH, DEF_PRINT_LEN);
474 strobj = PORT(lsp_strport)->name;
475 str = STRING(strobj)->data;
476 len = PORT(lsp_strport)->ptr;
477 (void)estrncpy(retstr, str, len);
478 retstr[len] = 0;
479 *retval = (INTBIG)retstr;
480 break;
481 case T_Environment:
482 (void)esnprintf(retstr, 100, x_("#[environment %u]"), (unsigned int)POINTER(obj));
483 *retval = (INTBIG)retstr;
484 break;
485 case T_String:
486 str = STRING(obj)->data;
487 len = STRING(obj)->size;
488 (void)estrncpy(retstr, str, len);
489 retstr[len] = 0;
490 *retval = (INTBIG)retstr;
491 break;
492 case T_Vector:
493 PORT(lsp_strport)->ptr = 0;
494 PORT(lsp_strport)->name = Make_String(0, 0);
495 PORT(lsp_strport)->flags = P_STRING|P_OPEN;
496 Pr_Vector(lsp_strport, obj, 1, DEF_PRINT_DEPTH, DEF_PRINT_LEN);
497 strobj = PORT(lsp_strport)->name;
498 str = STRING(strobj)->data;
499 len = PORT(lsp_strport)->ptr;
500 (void)estrncpy(retstr, str, len);
501 retstr[len] = 0;
502 *retval = (INTBIG)retstr;
503 break;
504 case T_Primitive:
505 (void)esnprintf(retstr, 100, x_("#[primitive %s]"), PRIM(obj)->name);
506 *retval = (INTBIG)retstr;
507 break;
508 case T_Compound:
509 if (Nullp(COMPOUND(obj)->name))
510 {
511 (void)esnprintf(retstr, 100, x_("#[compound %u]"), (unsigned int)POINTER(obj));
512 *retval = (INTBIG)retstr;
513 break;
514 }
515 PORT(lsp_strport)->ptr = 0;
516 PORT(lsp_strport)->name = Make_String(0, 0);
517 PORT(lsp_strport)->flags = P_STRING|P_OPEN;
518 Printf(lsp_strport, x_("#[compound "));
519 Print_Object(COMPOUND(obj)->name, lsp_strport, 1, DEF_PRINT_DEPTH,
520 DEF_PRINT_LEN);
521 Print_Char(lsp_strport, ']');
522 strobj = PORT(lsp_strport)->name;
523 str = STRING(strobj)->data;
524 len = PORT(lsp_strport)->ptr;
525 (void)estrncpy(retstr, str, len);
526 retstr[len] = 0;
527 *retval = (INTBIG)retstr;
528 break;
529 case T_Control_Point:
530 (void)esnprintf(retstr, 100, x_("#[control-point %u]"), (unsigned int)POINTER(obj));
531 *retval = (INTBIG)retstr;
532 break;
533 case T_Promise:
534 (void)esnprintf(retstr, 100, x_("#[promise %u]"), (unsigned int)POINTER(obj));
535 *retval = (INTBIG)retstr;
536 break;
537 case T_Port:
538 switch (PORT(obj)->flags & (P_INPUT|P_BIDIR))
539 {
540 case 0: p = x_("output"); break;
541 case P_INPUT: p = x_("input"); break;
542 default: p = x_("input-output"); break;
543 }
544 if ((PORT(obj)->flags&P_STRING) != 0)
545 (void)esnprintf(retstr, 100, x_("#[string-%s-port %u]"), p,
546 (unsigned int)POINTER(obj)); else
547 {
548 strobj = PORT(obj)->name;
549 str = STRING(strobj)->data;
550 len = STRING(strobj)->size;
551 (void)esnprintf(retstr, 100, x_("#[file-%s-port "), p);
552 (void)estrncat(retstr, str, len);
553 (void)estrcat(retstr, x_("]"));
554 }
555 *retval = (INTBIG)retstr;
556 break;
557 case T_End_Of_File:
558 *retval = (INTBIG)x_("#[end-of-file]");
559 break;
560 case T_Autoload:
561 PORT(lsp_strport)->ptr = 0;
562 PORT(lsp_strport)->name = Make_String(0, 0);
563 PORT(lsp_strport)->flags = P_STRING|P_OPEN;
564 Printf(lsp_strport, x_("#[autoload "));
565 Print_Object(AUTOLOAD(obj)->files, lsp_strport, 1, DEF_PRINT_DEPTH,
566 DEF_PRINT_LEN);
567 Print_Char(lsp_strport, ']');
568 strobj = PORT(lsp_strport)->name;
569 str = STRING(strobj)->data;
570 len = PORT(lsp_strport)->ptr;
571 (void)estrncpy(retstr, str, len);
572 retstr[len] = 0;
573 *retval = (INTBIG)retstr;
574 break;
575 case T_Macro:
576 if (Nullp(MACRO(obj)->name))
577 {
578 (void)esnprintf(retstr, 100, x_("#[macro %u]"), (unsigned int)POINTER(obj));
579 *retval = (INTBIG)retstr;
580 break;
581 }
582 PORT(lsp_strport)->ptr = 0;
583 PORT(lsp_strport)->name = Make_String(0, 0);
584 PORT(lsp_strport)->flags = P_STRING|P_OPEN;
585 Printf(lsp_strport, x_("#[macro "));
586 Print_Object(MACRO(obj)->name, lsp_strport, 1, DEF_PRINT_DEPTH,
587 DEF_PRINT_LEN);
588 Print_Char(lsp_strport, ']');
589 strobj = PORT(lsp_strport)->name;
590 str = STRING(strobj)->data;
591 len = PORT(lsp_strport)->ptr;
592 (void)estrncpy(retstr, str, len);
593 retstr[len] = 0;
594 *retval = (INTBIG)retstr;
595 break;
596 case T_Broken_Heart:
597 *retval = (INTBIG)x_("!!broken-heart!!");
598 break;
599 default:
600 if (t < 0) break;
601 if (!Types[t].name) break;
602 PORT(lsp_strport)->ptr = 0;
603 PORT(lsp_strport)->name = Make_String(0, 0);
604 PORT(lsp_strport)->flags = P_STRING|P_OPEN;
605 (*Types[t].print)(obj, lsp_strport, 1, DEF_PRINT_DEPTH, DEF_PRINT_LEN);
606 strobj = PORT(lsp_strport)->name;
607 str = STRING(strobj)->data;
608 len = PORT(lsp_strport)->ptr;
609 (void)estrncpy(retstr, str, len);
610 retstr[len] = 0;
611 *retval = (INTBIG)retstr;
612 break;
613 }
614 break;
615
616 default:
617 return(TRUE);
618 }
619
620 if ((type&VISARRAY) != 0)
621 {
622 retarray[0] = *retval;
623 *retval = (INTBIG)retarray;
624 }
625 return(FALSE);
626 }
627
628 /*
629 * routine to convert a numeric Lisp ELKObject into an integer. Returns true on error
630 */
lsp_getnumericobject(ELKObject obj,INTBIG * val)631 BOOLEAN lsp_getnumericobject(ELKObject obj, INTBIG *val)
632 {
633 switch (TYPE(obj))
634 {
635 case T_Fixnum: *val = FIXNUM(obj); return(FALSE);
636 case T_Bignum: *val = Bignum_To_Integer(obj); return(FALSE);
637 case T_Flonum: *val = (INTBIG)FLONUM(obj)->val; return(FALSE);
638 case T_Symbol:
639 if (EQ(obj, lsp_displayablesym)) { *val = VDISPLAY; return(FALSE); }
640 break;
641 }
642 return(TRUE);
643 }
644
645 /*
646 * routine to convert a numeric Lisp ELKObject into a string. Returns zero on error
647 */
lsp_getstringobject(ELKObject obj)648 CHAR *lsp_getstringobject(ELKObject obj)
649 {
650 static CHAR retval[256];
651 CHAR *str;
652 INTBIG len;
653
654 switch (TYPE(obj))
655 {
656 case T_Symbol:
657 obj = SYMBOL(obj)->name;
658 /* FALLTHROUGH */
659 case T_String:
660 str = STRING(obj)->data;
661 len = STRING(obj)->size;
662 (void)estrncpy(retval, str, len);
663 retval[len] = 0;
664 return(retval);
665 }
666 return(0);
667 }
668
669
670 /*
671 * routine to convert a Lisp ELKObject into an Electric addr/type pair
672 */
lsp_getaddrandtype(ELKObject oaddr,INTBIG * addr,INTBIG * type)673 void lsp_getaddrandtype(ELKObject oaddr, INTBIG *addr, INTBIG *type)
674 {
675 INTBIG otype;
676 static CHAR retval[256];
677 CHAR *str;
678 INTBIG len;
679
680 *type = VUNKNOWN;
681 otype = TYPE(oaddr);
682 if (otype == T_Fixnum)
683 {
684 *type = VINTEGER;
685 *addr = FIXNUM(oaddr);
686 return;
687 }
688 if (otype == T_Bignum)
689 {
690 *type = VINTEGER;
691 *addr = Bignum_To_Integer(oaddr);
692 return;
693 }
694 if (otype == T_Flonum)
695 {
696 *type = VFLOAT;
697 *addr = castint((float)FLONUM(oaddr)->val);
698 return;
699 }
700 if (otype == T_String)
701 {
702 *type = VSTRING;
703 str = STRING(oaddr)->data;
704 len = STRING(oaddr)->size;
705 (void)estrncpy(retval, str, len);
706 retval[len] = 0;
707 *addr = (INTBIG)retval;
708 return;
709 }
710 if (otype == T_ENodeInst) *type = VNODEINST; else
711 if (otype == T_ENodeProto) *type = VNODEPROTO; else
712 if (otype == T_EPortArcInst) *type = VPORTARCINST; else
713 if (otype == T_EPortExpInst) *type = VPORTEXPINST; else
714 if (otype == T_EPortProto) *type = VPORTPROTO; else
715 if (otype == T_EArcInst) *type = VARCINST; else
716 if (otype == T_EArcProto) *type = VARCPROTO; else
717 if (otype == T_EGeom) *type = VGEOM; else
718 if (otype == T_ELibrary) *type = VLIBRARY; else
719 if (otype == T_ETechnology) *type = VTECHNOLOGY; else
720 if (otype == T_ETool) *type = VTOOL; else
721 if (otype == T_ERTNode) *type = VRTNODE; else
722 if (otype == T_ENetwork) *type = VNETWORK; else
723 if (otype == T_EView) *type = VVIEW; else
724 if (otype == T_EWindow) *type = VWINDOWPART; else
725 if (otype == T_EGraphics) *type = VGRAPHICS; else
726 if (otype == T_EConstraint) *type = VCONSTRAINT; else
727 if (otype == T_EWindowFrame) *type = VWINDOWFRAME; else
728 return;
729 *addr = EELECTRIC(oaddr)->handle;
730 }
731
lsp_makevarobject(INTBIG type,INTBIG addr)732 ELKObject lsp_makevarobject(INTBIG type, INTBIG addr)
733 {
734 ELKObject ret;
735
736 /* convert back to a Lisp object */
737 switch (type&VTYPE)
738 {
739 case VINTEGER: return(Make_Integer(addr));
740 case VSHORT:
741 case VBOOLEAN: return(Make_Fixnum(addr));
742 case VADDRESS: return(Make_Unsigned(addr));
743 /* case VCHAR: */ /* character variable */
744 /* case VFRACT: */ /* fractional integer (scaled by WHOLE) */
745 case VSTRING: return(Make_String((CHAR *)addr, estrlen((CHAR *)addr)));
746 case VFLOAT:
747 case VDOUBLE: return(Make_Reduced_Flonum((double)castfloat(addr)));
748 case VNODEINST:
749 ret = Make_EElectric(addr, T_ENodeInst);
750 if (ENODEINST(ret)->handle == NONODEINST) return(Null); else return(ret);
751 case VNODEPROTO:
752 ret = Make_EElectric(addr, T_ENodeProto);
753 if (ENODEPROTO(ret)->handle == NONODEPROTO) return(Null); else return(ret);
754 case VPORTARCINST:
755 ret = Make_EElectric(addr, T_EPortArcInst);
756 if (EPORTARCINST(ret)->handle == NOPORTARCINST) return(Null); else return(ret);
757 case VPORTEXPINST:
758 ret = Make_EElectric(addr, T_EPortExpInst);
759 if (EPORTEXPINST(ret)->handle == NOPORTEXPINST) return(Null); else return(ret);
760 case VPORTPROTO:
761 ret = Make_EElectric(addr, T_EPortProto);
762 if (EPORTPROTO(ret)->handle == NOPORTPROTO) return(Null); else return(ret);
763 case VARCINST:
764 ret = Make_EElectric(addr, T_EArcInst);
765 if (EARCINST(ret)->handle == NOARCINST) return(Null); else return(ret);
766 case VARCPROTO:
767 ret = Make_EElectric(addr, T_EArcProto);
768 if (EARCPROTO(ret)->handle == NOARCPROTO) return(Null); else return(ret);
769 case VGEOM:
770 ret = Make_EElectric(addr, T_EGeom);
771 if (EGEOM(ret)->handle == NOGEOM) return(Null); else return(ret);
772 case VLIBRARY:
773 ret = Make_EElectric(addr, T_ELibrary);
774 if (ELIBRARY(ret)->handle == NOLIBRARY) return(Null); else return(ret);
775 case VTECHNOLOGY:
776 ret = Make_EElectric(addr, T_ETechnology);
777 if (ETECHNOLOGY(ret)->handle == NOTECHNOLOGY) return(Null); else return(ret);
778 case VTOOL:
779 ret = Make_EElectric(addr, T_ETool);
780 if (ETOOL(ret)->handle == NOTOOL) return(Null); else return(ret);
781 case VRTNODE:
782 ret = Make_EElectric(addr, T_ERTNode);
783 if (ERTNODE(ret)->handle == NORTNODE) return(Null); else return(ret);
784 case VNETWORK:
785 ret = Make_EElectric(addr, T_ENetwork);
786 if (ENETWORK(ret)->handle == NONETWORK) return(Null); else return(ret);
787 case VVIEW:
788 ret = Make_EElectric(addr, T_EView);
789 if (EVIEW(ret)->handle == NOVIEW) return(Null); else return(ret);
790 case VWINDOWPART:
791 ret = Make_EElectric(addr, T_EWindow);
792 if (EWINDOW(ret)->handle == NOWINDOWPART) return(Null); else return(ret);
793 case VGRAPHICS:
794 ret = Make_EElectric(addr, T_EGraphics);
795 if (EGRAPHICS(ret)->handle == NOGRAPHICS) return(Null); else return(ret);
796 case VCONSTRAINT:
797 ret = Make_EElectric(addr, T_EConstraint);
798 if (ECONSTRAINT(ret)->handle == NOCONSTRAINT) return(Null); else return(ret);
799 case VWINDOWFRAME:
800 ret = Make_EElectric(addr, T_EWindowFrame);
801 if (EWINDOWFRAME(ret)->handle == NOWINDOWFRAME) return(Null); else return(ret);
802 }
803 return(Null);
804 }
805
806 /************************* DATABASE EXAMINATION ROUTINES *************************/
807
lsp_curlib(void)808 ELKObject lsp_curlib(void)
809 {
810 return(Make_EElectric((INTBIG)el_curlib, T_ELibrary));
811 }
812
lsp_curtech(void)813 ELKObject lsp_curtech(void)
814 {
815 return(Make_EElectric((INTBIG)el_curtech, T_ETechnology));
816 }
817
lsp_getval(ELKObject oaddr,ELKObject oattr)818 ELKObject lsp_getval(ELKObject oaddr, ELKObject oattr)
819 {
820 INTBIG type, addr, len, i;
821 CHAR *name;
822 ELKObject v;
823 VARIABLE *var;
824 GC_Node;
825
826 /* get inputs from LISP */
827 lsp_getaddrandtype(oaddr, &addr, &type);
828 if (type == VUNKNOWN) return(Null);
829 name = lsp_getstringobject(oattr);
830 if (name == 0) return(Null);
831
832 /* get the variable */
833 var = getval(addr, type, -1, name);
834 if (var == NOVARIABLE) return(Null);
835 if ((var->type&VISARRAY) == 0)
836 return(lsp_makevarobject(var->type, var->addr));
837 len = getlength(var);
838 v = Make_Vector(len, Null);
839 GC_Link(v);
840 for(i=0; i<len; i++)
841 VECTOR(v)->data[i] = lsp_makevarobject(var->type, ((INTBIG *)var->addr)[i]);
842 GC_Unlink;
843 return(v);
844 }
845
lsp_getparentval(ELKObject oname,ELKObject odef,ELKObject oheight)846 ELKObject lsp_getparentval(ELKObject oname, ELKObject odef, ELKObject oheight)
847 {
848 INTBIG height;
849 CHAR *name;
850
851 /* get inputs from LISP */
852 name = lsp_getstringobject(oname);
853 if (name == 0) return(Null);
854 if (lsp_getnumericobject(oheight, &height)) return(Null);
855
856 /* call common evaluation code */
857 return(lsp_dogetparentval(name, odef, height));
858 }
859
lsp_dogetparentval(CHAR * name,ELKObject odef,INTBIG height)860 ELKObject lsp_dogetparentval(CHAR *name, ELKObject odef, INTBIG height)
861 {
862 INTBIG len, i;
863 ELKObject v;
864 VARIABLE *var;
865 GC_Node;
866
867 /* get the variable */
868 var = getparentval(name, height);
869 if (var == NOVARIABLE) return(odef);
870 if ((var->type&VISARRAY) == 0)
871 return(lsp_makevarobject(var->type, var->addr));
872 len = getlength(var);
873 v = Make_Vector(len, Null);
874 GC_Link(v);
875 for(i=0; i<len; i++)
876 VECTOR(v)->data[i] = lsp_makevarobject(var->type, ((INTBIG *)var->addr)[i]);
877 GC_Unlink;
878 return(v);
879 }
880
lsp_P(ELKObject oname)881 ELKObject lsp_P(ELKObject oname)
882 {
883 CHAR *name, fullname[300];
884
885 /* get inputs from LISP */
886 name = lsp_getstringobject(oname);
887 if (name == 0) return(Null);
888 esnprintf(fullname, 300, x_("ATTR_%s"), name);
889
890 /* call common evaluation code */
891 return(lsp_dogetparentval(fullname, Null, 1));
892 }
893
lsp_PD(ELKObject oname,ELKObject odef)894 ELKObject lsp_PD(ELKObject oname, ELKObject odef)
895 {
896 CHAR *name, fullname[300];
897
898 /* get inputs from LISP */
899 name = lsp_getstringobject(oname);
900 if (name == 0) return(Null);
901 esnprintf(fullname, 300, x_("ATTR_%s"), name);
902
903 /* call common evaluation code */
904 return(lsp_dogetparentval(fullname, odef, 1));
905 }
906
lsp_PAR(ELKObject oname)907 ELKObject lsp_PAR(ELKObject oname)
908 {
909 CHAR *name, fullname[300];
910
911 /* get inputs from LISP */
912 name = lsp_getstringobject(oname);
913 if (name == 0) return(Null);
914 esnprintf(fullname, 300, x_("ATTR_%s"), name);
915
916 /* call common evaluation code */
917 return(lsp_dogetparentval(fullname, Null, 0));
918 }
919
lsp_PARD(ELKObject oname,ELKObject odef)920 ELKObject lsp_PARD(ELKObject oname, ELKObject odef)
921 {
922 CHAR *name, fullname[300];
923
924 /* get inputs from LISP */
925 name = lsp_getstringobject(oname);
926 if (name == 0) return(Null);
927 esnprintf(fullname, 300, x_("ATTR_%s"), name);
928
929 /* call common evaluation code */
930 return(lsp_dogetparentval(fullname, odef, 0));
931 }
932
lsp_setval(ELKObject oaddr,ELKObject oname,ELKObject onaddr,ELKObject ontypebits)933 ELKObject lsp_setval(ELKObject oaddr, ELKObject oname, ELKObject onaddr, ELKObject ontypebits)
934 {
935 INTBIG type, addr, len, i, ntype, naddr, ntypebits, lasttype, thisaddr, ifloat;
936 CHAR *name;
937 VARIABLE *var;
938 float f;
939
940 /* get inputs from LISP */
941 lsp_getaddrandtype(oaddr, &addr, &type);
942 if (type == VUNKNOWN) return(Null);
943 name = lsp_getstringobject(oname);
944 if (name == 0) return(Null);
945 if (TYPE(onaddr) == T_Vector)
946 {
947 /* setting an array */
948 len = VECTOR(onaddr)->size;
949 naddr = (INTBIG)emalloc(len * SIZEOFINTBIG, el_tempcluster);
950 if (naddr == 0) return(Null);
951 for(i=0; i<len; i++)
952 {
953 lsp_getaddrandtype(VECTOR(onaddr)->data[i], &thisaddr, &ntype);
954 if (ntype == VSTRING)
955 (void)allocstring(&((CHAR **)naddr)[i], (CHAR *)thisaddr,
956 el_tempcluster); else
957 ((INTBIG *)naddr)[i] = thisaddr;
958
959 /* LINTED "lasttype" used in proper order */
960 if (i != 0 && lasttype == VINTEGER && ntype == VFLOAT)
961 {
962 f = castfloat(thisaddr);
963 ifloat = (INTBIG)f;
964 if (ifloat == (INTBIG)f)
965 {
966 ((INTBIG *)naddr)[i] = ifloat;
967 ntype = VINTEGER;
968 }
969 }
970 if (i != 0 && lasttype == VFLOAT && ntype == VINTEGER)
971 {
972 f = castfloat(((INTBIG *)naddr)[i-1]);
973 ifloat = (INTBIG)f;
974 if (ifloat == (INTBIG)f)
975 {
976 ((INTBIG *)naddr)[i-1] = ifloat;
977 lasttype = VINTEGER;
978 }
979 }
980 if (i != 0 && ntype != lasttype)
981 {
982 ttyputerr(_("Inconsistent type in array"));
983 return(Null);
984 }
985 lasttype = ntype;
986 }
987 ntype |= VISARRAY | (len << VLENGTHSH);
988 } else
989 {
990 /* setting a scalar */
991 lsp_getaddrandtype(onaddr, &naddr, &ntype);
992 if (ntype == VUNKNOWN) return(Null);
993 }
994 if (lsp_getnumericobject(ontypebits, &ntypebits)) return(Null);
995 ntype |= ntypebits;
996
997 /* set the variable */
998 var = setval(addr, type, name, naddr, ntype);
999 if ((ntype&VISARRAY) != 0)
1000 {
1001 if ((ntype&VTYPE) == VSTRING)
1002 for(i=0; i<len; i++) efree(((CHAR **)naddr)[i]);
1003 efree((CHAR *)naddr);
1004 }
1005 return(Make_Fixnum(var != NOVARIABLE));
1006 }
1007
lsp_setind(ELKObject oaddr,ELKObject oname,ELKObject oindex,ELKObject onaddr)1008 ELKObject lsp_setind(ELKObject oaddr, ELKObject oname, ELKObject oindex, ELKObject onaddr)
1009 {
1010 INTBIG type, addr, ntype, naddr, aindex;
1011 CHAR *name;
1012
1013 /* get inputs from LISP */
1014 lsp_getaddrandtype(oaddr, &addr, &type);
1015 if (type == VUNKNOWN) return(Null);
1016 name = lsp_getstringobject(oname);
1017 if (name == 0) return(Null);
1018 if (lsp_getnumericobject(oindex, &aindex)) return(Null);
1019 lsp_getaddrandtype(onaddr, &naddr, &ntype);
1020 if (ntype == VUNKNOWN) return(Null);
1021
1022 /* set the variable */
1023 return(Make_Fixnum(setind(addr, type, name, aindex, naddr)));
1024 }
1025
lsp_delval(ELKObject oaddr,ELKObject oname)1026 ELKObject lsp_delval(ELKObject oaddr, ELKObject oname)
1027 {
1028 INTBIG type, addr;
1029 CHAR *name;
1030
1031 /* get inputs from LISP */
1032 lsp_getaddrandtype(oaddr, &addr, &type);
1033 if (type == VUNKNOWN) return(Null);
1034 name = lsp_getstringobject(oname);
1035 if (name == 0) return(Null);
1036
1037 /* delete the variable */
1038 return(Make_Fixnum(delval(addr, type, name)));
1039 }
1040
lsp_initsearch(ELKObject olx,ELKObject ohx,ELKObject oly,ELKObject ohy,ELKObject onp)1041 ELKObject lsp_initsearch(ELKObject olx, ELKObject ohx, ELKObject oly, ELKObject ohy, ELKObject onp)
1042 {
1043 INTBIG lx, hx, ly, hy, sea;
1044 REGISTER NODEPROTO *np;
1045
1046 /* get inputs from LISP */
1047 if (lsp_getnumericobject(olx, &lx)) return(Null);
1048 if (lsp_getnumericobject(ohx, &hx)) return(Null);
1049 if (lsp_getnumericobject(oly, &ly)) return(Null);
1050 if (lsp_getnumericobject(ohy, &hy)) return(Null);
1051 Ensure_Type(onp, T_ENodeProto); np = ENODEPROTO(onp)->handle;
1052
1053 sea = initsearch(lx, hx, ly, hy, np);
1054 if (sea == -1) return(Null);
1055 return(Make_Integer(sea));
1056 }
1057
lsp_nextobject(ELKObject osea)1058 ELKObject lsp_nextobject(ELKObject osea)
1059 {
1060 INTBIG sea;
1061 REGISTER GEOM *g;
1062
1063 /* get inputs from LISP */
1064 if (lsp_getnumericobject(osea, &sea)) return(Null);
1065
1066 g = nextobject(sea);
1067 if (g == NOGEOM) return(Null);
1068 return(Make_EElectric((INTBIG)g, T_EGeom));
1069 }
1070
1071 /****************************** TOOL ROUTINES ******************************/
1072
lsp_gettool(ELKObject oname)1073 ELKObject lsp_gettool(ELKObject oname)
1074 {
1075 CHAR *name;
1076 REGISTER TOOL *tool;
1077
1078 /* get inputs from LISP */
1079 name = lsp_getstringobject(oname);
1080 if (name == 0) return(Null);
1081
1082 tool = gettool(name);
1083 if (tool == NOTOOL) return(Null);
1084 return(Make_EElectric((INTBIG)tool, T_ETool));
1085 }
1086
lsp_maxtool(void)1087 ELKObject lsp_maxtool(void)
1088 {
1089 return(Make_Fixnum(el_maxtools));
1090 }
1091
lsp_indextool(ELKObject oindex)1092 ELKObject lsp_indextool(ELKObject oindex)
1093 {
1094 INTBIG aindex;
1095
1096 /* get inputs from LISP */
1097 if (lsp_getnumericobject(oindex, &aindex)) return(Null);
1098
1099 if (aindex < 0 || aindex >= el_maxtools) return(Null);
1100 return(Make_EElectric((INTBIG)&el_tools[aindex], T_ETool));
1101 }
1102
lsp_toolturnon(ELKObject otool)1103 ELKObject lsp_toolturnon(ELKObject otool)
1104 {
1105 REGISTER TOOL *tool;
1106
1107 /* get inputs from LISP */
1108 Ensure_Type(otool, T_ETool); tool = ETOOL(otool)->handle;
1109
1110 toolturnon(tool);
1111 return(Null);
1112 }
1113
lsp_toolturnoff(ELKObject otool)1114 ELKObject lsp_toolturnoff(ELKObject otool)
1115 {
1116 REGISTER TOOL *tool;
1117
1118 /* get inputs from LISP */
1119 Ensure_Type(otool, T_ETool); tool = ETOOL(otool)->handle;
1120
1121 toolturnoff(tool, TRUE);
1122 return(Null);
1123 }
1124
1125 /****************************** LIBRARY ROUTINES ******************************/
1126
lsp_getlibrary(ELKObject oname)1127 ELKObject lsp_getlibrary(ELKObject oname)
1128 {
1129 CHAR *name;
1130 REGISTER LIBRARY *lib;
1131
1132 /* get inputs from LISP */
1133 name = lsp_getstringobject(oname);
1134 if (name == 0) return(Null);
1135
1136 lib = getlibrary(name);
1137 if (lib == NOLIBRARY) return(Null);
1138 return(Make_EElectric((INTBIG)lib, T_ELibrary));
1139 }
1140
lsp_newlibrary(ELKObject oname,ELKObject ofile)1141 ELKObject lsp_newlibrary(ELKObject oname, ELKObject ofile)
1142 {
1143 CHAR *name, *file;
1144 REGISTER LIBRARY *lib;
1145
1146 /* get inputs from LISP */
1147 name = lsp_getstringobject(oname);
1148 if (name == 0) return(Null);
1149 file = lsp_getstringobject(ofile);
1150 if (file == 0) return(Null);
1151
1152 lib = newlibrary(name, file);
1153 if (lib == NOLIBRARY) return(Null);
1154 return(Make_EElectric((INTBIG)lib, T_ELibrary));
1155 }
1156
lsp_killlibrary(ELKObject olib)1157 ELKObject lsp_killlibrary(ELKObject olib)
1158 {
1159 REGISTER LIBRARY *lib;
1160
1161 /* get inputs from LISP */
1162 Ensure_Type(olib, T_ELibrary); lib = ELIBRARY(olib)->handle;
1163
1164 killlibrary(lib);
1165 return(Null);
1166 }
1167
lsp_eraselibrary(ELKObject olib)1168 ELKObject lsp_eraselibrary(ELKObject olib)
1169 {
1170 REGISTER LIBRARY *lib;
1171
1172 /* get inputs from LISP */
1173 Ensure_Type(olib, T_ELibrary); lib = ELIBRARY(olib)->handle;
1174
1175 eraselibrary(lib);
1176 return(Null);
1177 }
1178
lsp_selectlibrary(ELKObject olib)1179 ELKObject lsp_selectlibrary(ELKObject olib)
1180 {
1181 REGISTER LIBRARY *lib;
1182
1183 /* get inputs from LISP */
1184 Ensure_Type(olib, T_ELibrary); lib = ELIBRARY(olib)->handle;
1185
1186 selectlibrary(lib, TRUE);
1187 return(Null);
1188 }
1189
1190 /****************************** NODEPROTO ROUTINES ******************************/
1191
lsp_getnodeproto(ELKObject oname)1192 ELKObject lsp_getnodeproto(ELKObject oname)
1193 {
1194 CHAR *name;
1195 REGISTER NODEPROTO *np;
1196
1197 /* get inputs from LISP */
1198 name = lsp_getstringobject(oname);
1199 if (name == 0) return(Null);
1200
1201 np = getnodeproto(name);
1202 if (np == NONODEPROTO) return(Null);
1203 return(Make_EElectric((INTBIG)np, T_ENodeProto));
1204 }
1205
lsp_newnodeproto(ELKObject oname,ELKObject olib)1206 ELKObject lsp_newnodeproto(ELKObject oname, ELKObject olib)
1207 {
1208 CHAR *name;
1209 REGISTER LIBRARY *lib;
1210 REGISTER NODEPROTO *np;
1211
1212 /* get inputs from LISP */
1213 Ensure_Type(olib, T_ELibrary); lib = ELIBRARY(olib)->handle;
1214 name = lsp_getstringobject(oname);
1215 if (name == 0) return(Null);
1216
1217 np = newnodeproto(name, lib);
1218 if (np == NONODEPROTO) return(Null);
1219 return(Make_EElectric((INTBIG)np, T_ENodeProto));
1220 }
1221
lsp_killnodeproto(ELKObject onp)1222 ELKObject lsp_killnodeproto(ELKObject onp)
1223 {
1224 REGISTER NODEPROTO *np;
1225
1226 /* get inputs from LISP */
1227 Ensure_Type(onp, T_ENodeProto); np = ENODEPROTO(onp)->handle;
1228
1229 return(Make_Fixnum(killnodeproto(np)?1:0));
1230 }
1231
lsp_copynodeproto(ELKObject onp,ELKObject otlib,ELKObject otname)1232 ELKObject lsp_copynodeproto(ELKObject onp, ELKObject otlib, ELKObject otname)
1233 {
1234 CHAR *tname;
1235 REGISTER LIBRARY *tlib;
1236 REGISTER NODEPROTO *np, *nnp;
1237
1238 /* get inputs from LISP */
1239 Ensure_Type(otlib, T_ELibrary); tlib = ELIBRARY(otlib)->handle;
1240 Ensure_Type(onp, T_ENodeProto); np = ENODEPROTO(onp)->handle;
1241 tname = lsp_getstringobject(otname);
1242 if (tname == 0) return(Null);
1243
1244 nnp = copynodeproto(np, tlib, tname, FALSE);
1245 if (nnp == NONODEPROTO) return(Null);
1246 return(Make_EElectric((INTBIG)nnp, T_ENodeProto));
1247 }
1248
lsp_iconview(ELKObject onp)1249 ELKObject lsp_iconview(ELKObject onp)
1250 {
1251 REGISTER NODEPROTO *np, *inp;
1252
1253 /* get inputs from LISP */
1254 Ensure_Type(onp, T_ENodeProto); np = ENODEPROTO(onp)->handle;
1255
1256 inp = iconview(np);
1257 if (inp == NONODEPROTO) return(Null);
1258 return(Make_EElectric((INTBIG)inp, T_ENodeProto));
1259 }
1260
lsp_contentsview(ELKObject onp)1261 ELKObject lsp_contentsview(ELKObject onp)
1262 {
1263 REGISTER NODEPROTO *np, *cnp;
1264
1265 /* get inputs from LISP */
1266 Ensure_Type(onp, T_ENodeProto); np = ENODEPROTO(onp)->handle;
1267
1268 cnp = contentsview(np);
1269 if (cnp == NONODEPROTO) return(Null);
1270 return(Make_EElectric((INTBIG)cnp, T_ENodeProto));
1271 }
1272
1273 /****************************** NODEINST ROUTINES ******************************/
1274
lsp_newnodeinst(ELKObject opro,ELKObject olx,ELKObject ohx,ELKObject oly,ELKObject ohy,ELKObject otr,ELKObject orot,ELKObject onp)1275 ELKObject lsp_newnodeinst(ELKObject opro, ELKObject olx, ELKObject ohx, ELKObject oly, ELKObject ohy,
1276 ELKObject otr, ELKObject orot, ELKObject onp)
1277 {
1278 REGISTER NODEPROTO *pro, *np;
1279 INTBIG lx, hx, ly, hy, tr, rot;
1280 REGISTER NODEINST *ni;
1281
1282 /* get inputs from LISP */
1283 Ensure_Type(opro, T_ENodeProto); pro = ENODEPROTO(opro)->handle;
1284 Ensure_Type(onp, T_ENodeProto); np = ENODEPROTO(onp)->handle;
1285 if (lsp_getnumericobject(olx, &lx)) return(Null);
1286 if (lsp_getnumericobject(ohx, &hx)) return(Null);
1287 if (lsp_getnumericobject(oly, &ly)) return(Null);
1288 if (lsp_getnumericobject(ohy, &hy)) return(Null);
1289 if (lsp_getnumericobject(otr, &tr)) return(Null);
1290 if (lsp_getnumericobject(orot, &rot)) return(Null);
1291
1292 ni = newnodeinst(pro, lx, hx, ly, hy, tr, rot, np);
1293 if (ni == NONODEINST) return(Null);
1294 return(Make_EElectric((INTBIG)ni, T_ENodeInst));
1295 }
1296
lsp_modifynodeinst(ELKObject oni,ELKObject odlx,ELKObject odly,ELKObject odhx,ELKObject odhy,ELKObject odrot,ELKObject odtr)1297 ELKObject lsp_modifynodeinst(ELKObject oni, ELKObject odlx, ELKObject odly, ELKObject odhx, ELKObject odhy,
1298 ELKObject odrot, ELKObject odtr)
1299 {
1300 INTBIG dlx, dly, dhx, dhy, drot, dtr;
1301 REGISTER NODEINST *ni;
1302
1303 /* get inputs from LISP */
1304 Ensure_Type(oni, T_ENodeInst); ni = ENODEINST(oni)->handle;
1305 if (lsp_getnumericobject(odlx, &dlx)) return(Null);
1306 if (lsp_getnumericobject(odly, &dly)) return(Null);
1307 if (lsp_getnumericobject(odhx, &dhx)) return(Null);
1308 if (lsp_getnumericobject(odhy, &dhy)) return(Null);
1309 if (lsp_getnumericobject(odrot, &drot)) return(Null);
1310 if (lsp_getnumericobject(odtr, &dtr)) return(Null);
1311
1312 modifynodeinst(ni, dlx, dly, dhx, dhy, drot, dtr);
1313 return(Null);
1314 }
1315
lsp_killnodeinst(ELKObject oni)1316 ELKObject lsp_killnodeinst(ELKObject oni)
1317 {
1318 REGISTER NODEINST *ni;
1319
1320 /* get inputs from LISP */
1321 Ensure_Type(oni, T_ENodeInst); ni = ENODEINST(oni)->handle;
1322
1323 return(Make_Fixnum(killnodeinst(ni)));
1324 }
1325
lsp_replacenodeinst(ELKObject oni,ELKObject opr)1326 ELKObject lsp_replacenodeinst(ELKObject oni, ELKObject opr)
1327 {
1328 REGISTER NODEINST *ni, *nni;
1329 REGISTER NODEPROTO *pr;
1330
1331 /* get inputs from LISP */
1332 Ensure_Type(oni, T_ENodeInst); ni = ENODEINST(oni)->handle;
1333 Ensure_Type(opr, T_ENodeProto); pr = ENODEPROTO(opr)->handle;
1334
1335 nni = replacenodeinst(ni, pr, FALSE, FALSE);
1336 if (nni == NONODEINST) return(Null);
1337 return(Make_EElectric((INTBIG)nni, T_ENodeInst));
1338 }
1339
lsp_nodefunction(ELKObject oni)1340 ELKObject lsp_nodefunction(ELKObject oni)
1341 {
1342 REGISTER NODEINST *ni;
1343
1344 /* get inputs from LISP */
1345 Ensure_Type(oni, T_ENodeInst); ni = ENODEINST(oni)->handle;
1346
1347 return(Make_Integer(nodefunction(ni)));
1348 }
1349
1350 /****************************** ARCINST ROUTINES ******************************/
1351
lsp_newarcinst(ELKObject opro,ELKObject owid,ELKObject obit,ELKObject ona,ELKObject opa,ELKObject oxa,ELKObject oya,ELKObject onb,ELKObject opb,ELKObject oxb,ELKObject oyb,ELKObject onp)1352 ELKObject lsp_newarcinst(ELKObject opro, ELKObject owid, ELKObject obit, ELKObject ona, ELKObject opa,
1353 ELKObject oxa, ELKObject oya, ELKObject onb, ELKObject opb, ELKObject oxb, ELKObject oyb, ELKObject onp)
1354 {
1355 REGISTER ARCPROTO *pro;
1356 REGISTER NODEPROTO *np;
1357 REGISTER NODEINST *na, *nb;
1358 REGISTER PORTPROTO *pa, *pb;
1359 INTBIG wid, bit, xa, ya, xb, yb;
1360 REGISTER ARCINST *ai;
1361
1362 /* get inputs from LISP */
1363 Ensure_Type(opro, T_EArcProto); pro = EARCPROTO(opro)->handle;
1364 if (lsp_getnumericobject(owid, &wid)) return(Null);
1365 if (lsp_getnumericobject(obit, &bit)) return(Null);
1366 Ensure_Type(ona, T_ENodeInst); na = ENODEINST(ona)->handle;
1367 Ensure_Type(opa, T_EPortProto); pa = EPORTPROTO(opa)->handle;
1368 if (lsp_getnumericobject(oxa, &xa)) return(Null);
1369 if (lsp_getnumericobject(oya, &ya)) return(Null);
1370 Ensure_Type(onb, T_ENodeInst); nb = ENODEINST(onb)->handle;
1371 Ensure_Type(opb, T_EPortProto); pb = EPORTPROTO(opb)->handle;
1372 if (lsp_getnumericobject(oxb, &xb)) return(Null);
1373 if (lsp_getnumericobject(oyb, &yb)) return(Null);
1374 Ensure_Type(onp, T_ENodeProto); np = ENODEPROTO(onp)->handle;
1375
1376 ai = newarcinst(pro, wid, bit, na, pa, xa, ya, nb, pb, xb, yb, np);
1377 if (ai == NOARCINST) return(Null);
1378 return(Make_EElectric((INTBIG)ai, T_EArcInst));
1379 }
1380
lsp_modifyarcinst(ELKObject oai,ELKObject odw,ELKObject odx1,ELKObject ody1,ELKObject odx2,ELKObject ody2)1381 ELKObject lsp_modifyarcinst(ELKObject oai, ELKObject odw, ELKObject odx1, ELKObject ody1, ELKObject odx2,
1382 ELKObject ody2)
1383 {
1384 INTBIG dw, dx1, dy1, dx2, dy2;
1385 REGISTER ARCINST *ai;
1386
1387 /* get inputs from LISP */
1388 Ensure_Type(oai, T_EArcInst); ai = EARCINST(oai)->handle;
1389 if (lsp_getnumericobject(odw, &dw)) return(Null);
1390 if (lsp_getnumericobject(odx1, &dx1)) return(Null);
1391 if (lsp_getnumericobject(ody1, &dy1)) return(Null);
1392 if (lsp_getnumericobject(odx2, &dx2)) return(Null);
1393 if (lsp_getnumericobject(ody2, &dy2)) return(Null);
1394
1395 return(Make_Fixnum(modifyarcinst(ai, dw, dx1, dy1, dx2, dy2)?1:0));
1396 }
1397
lsp_killarcinst(ELKObject oai)1398 ELKObject lsp_killarcinst(ELKObject oai)
1399 {
1400 REGISTER ARCINST *ai;
1401
1402 /* get inputs from LISP */
1403 Ensure_Type(oai, T_EArcInst); ai = EARCINST(oai)->handle;
1404
1405 return(Make_Fixnum(killarcinst(ai)?1:0));
1406 }
1407
lsp_replacearcinst(ELKObject oai,ELKObject opr)1408 ELKObject lsp_replacearcinst(ELKObject oai, ELKObject opr)
1409 {
1410 REGISTER ARCINST *ai, *nai;
1411 REGISTER ARCPROTO *pr;
1412
1413 /* get inputs from LISP */
1414 Ensure_Type(oai, T_EArcInst); ai = EARCINST(oai)->handle;
1415 Ensure_Type(opr, T_EArcProto); pr = EARCPROTO(opr)->handle;
1416
1417 nai = replacearcinst(ai, pr);
1418 if (nai == NOARCINST) return(Null);
1419 return(Make_EElectric((INTBIG)nai, T_EArcInst));
1420 }
1421
1422 /****************************** PORTPROTO ROUTINES ******************************/
1423
lsp_newportproto(ELKObject onp,ELKObject oni,ELKObject opp,ELKObject oname)1424 ELKObject lsp_newportproto(ELKObject onp, ELKObject oni, ELKObject opp, ELKObject oname)
1425 {
1426 CHAR *name;
1427 REGISTER NODEPROTO *np;
1428 REGISTER NODEINST *ni;
1429 REGISTER PORTPROTO *pp;
1430
1431 /* get inputs from LISP */
1432 Ensure_Type(onp, T_ENodeProto); np = ENODEPROTO(onp)->handle;
1433 Ensure_Type(oni, T_ENodeInst); ni = ENODEINST(oni)->handle;
1434 Ensure_Type(opp, T_EPortProto); pp = EPORTPROTO(opp)->handle;
1435 name = lsp_getstringobject(oname);
1436 if (name == 0) return(Null);
1437
1438 pp = newportproto(np, ni, pp, name);
1439 if (pp == NOPORTPROTO) return(Null);
1440 return(Make_EElectric((INTBIG)pp, T_EPortProto));
1441 }
1442
lsp_portposition(ELKObject oni,ELKObject opp)1443 ELKObject lsp_portposition(ELKObject oni, ELKObject opp)
1444 {
1445 REGISTER NODEINST *ni;
1446 REGISTER PORTPROTO *pp;
1447 ELKObject v;
1448 INTBIG x, y;
1449 GC_Node;
1450
1451 /* get inputs from LISP */
1452 Ensure_Type(oni, T_ENodeInst); ni = ENODEINST(oni)->handle;
1453 Ensure_Type(opp, T_EPortProto); pp = EPORTPROTO(opp)->handle;
1454
1455 portposition(ni, pp, &x, &y);
1456 v = Make_Vector(2, Null);
1457 GC_Link(v);
1458 VECTOR(v)->data[0] = Make_Integer(x);
1459 VECTOR(v)->data[1] = Make_Integer(y);
1460 GC_Unlink;
1461 return(v);
1462 }
1463
lsp_getportproto(ELKObject onp,ELKObject oname)1464 ELKObject lsp_getportproto(ELKObject onp, ELKObject oname)
1465 {
1466 CHAR *name;
1467 REGISTER NODEPROTO *np;
1468 REGISTER PORTPROTO *pp;
1469
1470 /* get inputs from LISP */
1471 Ensure_Type(onp, T_ENodeProto); np = ENODEPROTO(onp)->handle;
1472 name = lsp_getstringobject(oname);
1473 if (name == 0) return(Null);
1474
1475 pp = getportproto(np, name);
1476 if (pp == NOPORTPROTO) return(Null);
1477 return(Make_EElectric((INTBIG)pp, T_EPortProto));
1478 }
1479
lsp_killportproto(ELKObject onp,ELKObject opp)1480 ELKObject lsp_killportproto(ELKObject onp, ELKObject opp)
1481 {
1482 REGISTER PORTPROTO *pp;
1483 REGISTER NODEPROTO *np;
1484
1485 /* get inputs from LISP */
1486 Ensure_Type(opp, T_EPortProto); pp = EPORTPROTO(opp)->handle;
1487 Ensure_Type(onp, T_ENodeProto); np = ENODEPROTO(onp)->handle;
1488
1489 return(Make_Fixnum(killportproto(np, pp)?1:0));
1490 }
1491
lsp_moveportproto(ELKObject onp,ELKObject oopp,ELKObject onni,ELKObject onpp)1492 ELKObject lsp_moveportproto(ELKObject onp, ELKObject oopp, ELKObject onni, ELKObject onpp)
1493 {
1494 REGISTER NODEPROTO *np;
1495 REGISTER PORTPROTO *opp, *npp;
1496 REGISTER NODEINST *nni;
1497
1498 /* get inputs from LISP */
1499 Ensure_Type(onp, T_ENodeProto); np = ENODEPROTO(onp)->handle;
1500 Ensure_Type(oopp, T_EPortProto); opp = EPORTPROTO(oopp)->handle;
1501 Ensure_Type(onni, T_ENodeInst); nni = ENODEINST(onni)->handle;
1502 Ensure_Type(onpp, T_EPortProto); npp = EPORTPROTO(onpp)->handle;
1503
1504 return(Make_Fixnum(moveportproto(np, opp, nni, npp)?1:0));
1505 }
1506
1507 /*************************** CHANGE CONTROL ROUTINES ***************************/
1508
lsp_undoabatch(void)1509 ELKObject lsp_undoabatch(void)
1510 {
1511 INTBIG tool;
1512
1513 if (undoabatch((TOOL **)&tool) == 0) return(Null);
1514 return(Make_Fixnum(tool));
1515 }
1516
lsp_noundoallowed(void)1517 ELKObject lsp_noundoallowed(void)
1518 {
1519 noundoallowed();
1520 return(Null);
1521 }
1522
1523 /****************************** VIEW ROUTINES ******************************/
1524
lsp_getview(ELKObject oname)1525 ELKObject lsp_getview(ELKObject oname)
1526 {
1527 CHAR *name;
1528 REGISTER VIEW *v;
1529
1530 /* get inputs from LISP */
1531 name = lsp_getstringobject(oname);
1532 if (name == 0) return(Null);
1533
1534 v = getview(name);
1535 if (v == NOVIEW) return(Null);
1536 return(Make_EElectric((INTBIG)v, T_EView));
1537 }
1538
lsp_newview(ELKObject oname,ELKObject osname)1539 ELKObject lsp_newview(ELKObject oname, ELKObject osname)
1540 {
1541 CHAR *name, *sname;
1542 REGISTER VIEW *v;
1543
1544 /* get inputs from LISP */
1545 name = lsp_getstringobject(oname);
1546 if (name == 0) return(Null);
1547 sname = lsp_getstringobject(osname);
1548 if (sname == 0) return(Null);
1549
1550 v = newview(name, sname);
1551 if (v == NOVIEW) return(Null);
1552 return(Make_EElectric((INTBIG)v, T_EView));
1553 }
1554
lsp_killview(ELKObject ov)1555 ELKObject lsp_killview(ELKObject ov)
1556 {
1557 REGISTER VIEW *v;
1558
1559 /* get inputs from LISP */
1560 Ensure_Type(ov, T_EView); v = EVIEW(ov)->handle;
1561
1562 return(Make_Fixnum(killview(v)?1:0));
1563 }
1564
1565 /*************************** MISCELLANEOUS ROUTINES ***************************/
1566
lsp_telltool(long argc,ELKObject argv[])1567 ELKObject lsp_telltool(long argc, ELKObject argv[])
1568 {
1569 REGISTER TOOL *tool;
1570 REGISTER INTBIG i;
1571 CHAR *par[20], *ret;
1572
1573 /* get inputs from LISP */
1574 if (argc < 1) return(Null);
1575 Ensure_Type(argv[0], T_ETool); tool = ETOOL(argv[0])->handle;
1576 argc--; argv++;
1577 for(i=0; i<argc; i++)
1578 {
1579 ret = lsp_getstringobject(argv[i]);
1580 if (ret == 0) return(Null);
1581 (void)allocstring(&par[i], ret, el_tempcluster);
1582 }
1583
1584 telltool(tool, argc, par);
1585 for(i=0; i<argc; i++) efree(par[i]);
1586 return(Make_Fixnum(0)); /* !!! actually should not return a value */
1587 }
1588
lsp_getarcproto(ELKObject oname)1589 ELKObject lsp_getarcproto(ELKObject oname)
1590 {
1591 CHAR *name;
1592 REGISTER ARCPROTO *ap;
1593
1594 /* get inputs from LISP */
1595 name = lsp_getstringobject(oname);
1596 if (name == 0) return(Null);
1597
1598 ap = getarcproto(name);
1599 if (ap == NOARCPROTO) return(Null);
1600 return(Make_EElectric((INTBIG)ap, T_EArcProto));
1601 }
1602
lsp_gettechnology(ELKObject oname)1603 ELKObject lsp_gettechnology(ELKObject oname)
1604 {
1605 CHAR *name;
1606 REGISTER TECHNOLOGY *tech;
1607
1608 /* get inputs from LISP */
1609 name = lsp_getstringobject(oname);
1610 if (name == 0) return(Null);
1611
1612 tech = gettechnology(name);
1613 if (tech == NOTECHNOLOGY) return(Null);
1614 return(Make_EElectric((INTBIG)tech, T_ETechnology));
1615 }
1616
lsp_getpinproto(ELKObject oap)1617 ELKObject lsp_getpinproto(ELKObject oap)
1618 {
1619 REGISTER ARCPROTO *ap;
1620 REGISTER NODEPROTO *np;
1621
1622 /* get inputs from LISP */
1623 Ensure_Type(oap, T_EArcProto); ap = EARCPROTO(oap)->handle;
1624
1625 np = getpinproto(ap);
1626 if (np == NONODEPROTO) return(Null);
1627 return(Make_EElectric((INTBIG)np, T_ENodeProto));
1628 }
1629
lsp_getnetwork(ELKObject oname,ELKObject onp)1630 ELKObject lsp_getnetwork(ELKObject oname, ELKObject onp)
1631 {
1632 CHAR *name;
1633 REGISTER NETWORK *net;
1634 REGISTER NODEPROTO *np;
1635
1636 /* get inputs from LISP */
1637 name = lsp_getstringobject(oname);
1638 if (name == 0) return(Null);
1639 Ensure_Type(onp, T_ENodeProto); np = ENODEPROTO(onp)->handle;
1640
1641 net = getnetwork(name, np);
1642 if (net == NONETWORK) return(Null);
1643 return(Make_EElectric((INTBIG)net, T_ENetwork));
1644 }
1645
1646 /****************************** INITIALIZATION ******************************/
1647
init_lib_electric(void)1648 void init_lib_electric(void)
1649 {
1650 T_ENodeInst = Define_Type(0, x_("nodeinst"), NOFUNC, sizeof (struct S_ENodeInst),
1651 EElectric_Equal, EElectric_Equal, ENodeInst_Print, NOFUNC);
1652 T_ENodeProto = Define_Type(0, x_("nodeproto"), NOFUNC, sizeof (struct S_ENodeProto),
1653 EElectric_Equal, EElectric_Equal, ENodeProto_Print, NOFUNC);
1654 T_EPortArcInst = Define_Type(0, x_("portarcinst"), NOFUNC, sizeof (struct S_EPortArcInst),
1655 EElectric_Equal, EElectric_Equal, EPortArcInst_Print, NOFUNC);
1656 T_EPortExpInst = Define_Type(0, x_("portexpinst"), NOFUNC, sizeof (struct S_EPortExpInst),
1657 EElectric_Equal, EElectric_Equal, EPortExpInst_Print, NOFUNC);
1658 T_EPortProto = Define_Type(0, x_("portproto"), NOFUNC, sizeof (struct S_EPortProto),
1659 EElectric_Equal, EElectric_Equal, EPortProto_Print, NOFUNC);
1660 T_EArcInst = Define_Type(0, x_("arcinst"), NOFUNC, sizeof (struct S_EArcInst),
1661 EElectric_Equal, EElectric_Equal, EArcInst_Print, NOFUNC);
1662 T_EArcProto = Define_Type(0, x_("arcproto"), NOFUNC, sizeof (struct S_EArcProto),
1663 EElectric_Equal, EElectric_Equal, EArcProto_Print, NOFUNC);
1664 T_EGeom = Define_Type(0, x_("geom"), NOFUNC, sizeof (struct S_EGeom),
1665 EElectric_Equal, EElectric_Equal, EGeom_Print, NOFUNC);
1666 T_ELibrary = Define_Type(0, x_("library"), NOFUNC, sizeof (struct S_ELibrary),
1667 EElectric_Equal, EElectric_Equal, ELibrary_Print, NOFUNC);
1668 T_ETechnology = Define_Type(0, x_("technology"), NOFUNC, sizeof (struct S_ETechnology),
1669 EElectric_Equal, EElectric_Equal, ETechnology_Print, NOFUNC);
1670 T_ETool = Define_Type(0, x_("tool"), NOFUNC, sizeof (struct S_ETool),
1671 EElectric_Equal, EElectric_Equal, ETool_Print, NOFUNC);
1672 T_ERTNode = Define_Type(0, x_("rtnode"), NOFUNC, sizeof (struct S_ERTNode),
1673 EElectric_Equal, EElectric_Equal, ERTNode_Print, NOFUNC);
1674 T_ENetwork = Define_Type(0, x_("network"), NOFUNC, sizeof (struct S_ENetwork),
1675 EElectric_Equal, EElectric_Equal, ENetwork_Print, NOFUNC);
1676 T_EView = Define_Type(0, x_("view"), NOFUNC, sizeof (struct S_EView),
1677 EElectric_Equal, EElectric_Equal, EView_Print, NOFUNC);
1678 T_EWindow = Define_Type(0, x_("window"), NOFUNC, sizeof (struct S_EWindow),
1679 EElectric_Equal, EElectric_Equal, EWindow_Print, NOFUNC);
1680 T_EGraphics = Define_Type(0, x_("graphics"), NOFUNC, sizeof (struct S_EGraphics),
1681 EElectric_Equal, EElectric_Equal, EGraphics_Print, NOFUNC);
1682 T_EConstraint = Define_Type(0, x_("constraint"), NOFUNC, sizeof (struct S_EConstraint),
1683 EElectric_Equal, EElectric_Equal, EConstraint_Print, NOFUNC);
1684 T_EWindowFrame = Define_Type(0, x_("windowframe"), NOFUNC, sizeof (struct S_EWindowFrame),
1685 EElectric_Equal, EElectric_Equal, EWindowFrame_Print, NOFUNC);
1686
1687 /* define the query predicates */
1688 Define_Primitive((ELKObject(*)(ELLIPSIS))P_ENodeInstP, x_("nodeinst?"), 1, 1, EVAL);
1689 Define_Primitive((ELKObject(*)(ELLIPSIS))P_ENodeProtoP, x_("nodeproto?"), 1, 1, EVAL);
1690 Define_Primitive((ELKObject(*)(ELLIPSIS))P_EPortArcInstP, x_("portarcinst?"), 1, 1, EVAL);
1691 Define_Primitive((ELKObject(*)(ELLIPSIS))P_EPortExpInstP, x_("portexpinst?"), 1, 1, EVAL);
1692 Define_Primitive((ELKObject(*)(ELLIPSIS))P_EPortProtoP, x_("portproto?"), 1, 1, EVAL);
1693 Define_Primitive((ELKObject(*)(ELLIPSIS))P_EArcInstP, x_("arcinst?"), 1, 1, EVAL);
1694 Define_Primitive((ELKObject(*)(ELLIPSIS))P_EArcProtoP, x_("arcproto?"), 1, 1, EVAL);
1695 Define_Primitive((ELKObject(*)(ELLIPSIS))P_EGeomP, x_("geom?"), 1, 1, EVAL);
1696 Define_Primitive((ELKObject(*)(ELLIPSIS))P_ELibraryP, x_("library?"), 1, 1, EVAL);
1697 Define_Primitive((ELKObject(*)(ELLIPSIS))P_ETechnologyP, x_("technology?"), 1, 1, EVAL);
1698 Define_Primitive((ELKObject(*)(ELLIPSIS))P_EToolP, x_("tool?"), 1, 1, EVAL);
1699 Define_Primitive((ELKObject(*)(ELLIPSIS))P_ERTNodeP, x_("rtnode?"), 1, 1, EVAL);
1700 Define_Primitive((ELKObject(*)(ELLIPSIS))P_ENetworkP, x_("network?"), 1, 1, EVAL);
1701 Define_Primitive((ELKObject(*)(ELLIPSIS))P_EViewP, x_("view?"), 1, 1, EVAL);
1702 Define_Primitive((ELKObject(*)(ELLIPSIS))P_EWindowP, x_("window?"), 1, 1, EVAL);
1703 Define_Primitive((ELKObject(*)(ELLIPSIS))P_EGraphicsP, x_("graphics?"), 1, 1, EVAL);
1704 Define_Primitive((ELKObject(*)(ELLIPSIS))P_EConstraintP, x_("constraint?"), 1, 1, EVAL);
1705 Define_Primitive((ELKObject(*)(ELLIPSIS))P_EWindowFrameP, x_("windowframe?"), 1, 1, EVAL);
1706
1707 /* define symbols */
1708 Define_Symbol(&lsp_displayablesym, x_("displayable"));
1709
1710 /* define the database examination predicates */
1711 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_curlib, x_("curlib"), 0, 0, EVAL);
1712 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_curtech, x_("curtech"), 0, 0, EVAL);
1713 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_getval, x_("getval"), 2, 2, EVAL);
1714 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_getparentval, x_("getparentval"), 3, 3, EVAL);
1715 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_P, x_("P"), 1, 1, EVAL);
1716 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_PD, x_("PD"), 2, 2, EVAL);
1717 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_PAR, x_("PAR"), 1, 1, EVAL);
1718 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_PARD, x_("PARD"), 2, 2, EVAL);
1719 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_setval, x_("setval"), 4, 4, EVAL);
1720 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_setind, x_("setind"), 4, 4, EVAL);
1721 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_delval, x_("delval"), 2, 2, EVAL);
1722 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_initsearch, x_("initsearch"), 5, 5, EVAL);
1723 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_nextobject, x_("nextobject"), 1, 1, EVAL);
1724
1725 /* define the tool predicates */
1726 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_gettool, x_("gettool"), 1, 1, EVAL);
1727 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_maxtool, x_("maxtool"), 0, 0, EVAL);
1728 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_indextool, x_("indextool"), 1, 1, EVAL);
1729 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_toolturnon, x_("toolturnon"), 1, 1, EVAL);
1730 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_toolturnoff, x_("toolturnoff"), 1, 1, EVAL);
1731
1732 /* define the library predicates */
1733 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_getlibrary, x_("getlibrary"), 1, 1, EVAL);
1734 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_newlibrary, x_("newlibrary"), 2, 2, EVAL);
1735 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_killlibrary, x_("killlibrary"), 1, 1, EVAL);
1736 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_eraselibrary, x_("eraselibrary"), 1, 1, EVAL);
1737 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_selectlibrary, x_("selectlibrary"), 1, 1, EVAL);
1738
1739 /* define the nodeproto predicates */
1740 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_getnodeproto, x_("getnodeproto"), 1, 1, EVAL);
1741 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_newnodeproto, x_("newnodeproto"), 2, 2, EVAL);
1742 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_killnodeproto, x_("killnodeproto"), 1, 1, EVAL);
1743 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_copynodeproto, x_("copynodeproto"), 3, 3, EVAL);
1744 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_iconview, x_("iconview"), 1, 1, EVAL);
1745 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_contentsview, x_("contentsview"), 1, 1, EVAL);
1746
1747 /* define the nodeinst predicates */
1748 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_newnodeinst, x_("newnodeinst"), 8, 8, EVAL);
1749 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_modifynodeinst, x_("modifynodeinst"), 7, 7, EVAL);
1750 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_killnodeinst, x_("killnodeinst"), 1, 1, EVAL);
1751 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_replacenodeinst, x_("replacenodeinst"), 2, 2,
1752 EVAL);
1753 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_nodefunction, x_("nodefunction"), 1, 1, EVAL);
1754
1755 /* define the arcinst predicates */
1756 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_newarcinst, x_("newarcinst"), 12, 12, EVAL);
1757 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_modifyarcinst, x_("modifyarcinst"), 6, 6, EVAL);
1758 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_killarcinst, x_("killarcinst"), 1, 1, EVAL);
1759 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_replacearcinst, x_("replacearcinst"), 2, 2, EVAL);
1760
1761 /* define the portproto predicates */
1762 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_getportproto, x_("getportproto"), 2, 2, EVAL);
1763 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_newportproto, x_("newportproto"), 4, 4, EVAL);
1764 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_portposition, x_("portposition"), 2, 2, EVAL);
1765 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_killportproto, x_("killportproto"), 2, 2, EVAL);
1766 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_moveportproto, x_("moveportproto"), 4, 4, EVAL);
1767
1768 /* define the change control predicates */
1769 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_undoabatch, x_("undoabatch"), 0, 0, EVAL);
1770 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_noundoallowed, x_("noundoallowed"), 0, 0, EVAL);
1771
1772 /* define the view predicates */
1773 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_getview, x_("getview"), 1, 1, EVAL);
1774 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_newview, x_("newview"), 2, 2, EVAL);
1775 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_killview, x_("killview"), 1, 1, EVAL);
1776
1777 /* define the miscellaneous predicates */
1778 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_telltool, x_("telltool"), 1, MANY, VARARGS);
1779 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_getarcproto, x_("getarcproto"), 1, 1, EVAL);
1780 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_gettechnology, x_("gettechnology"), 1, 1, EVAL);
1781 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_getpinproto, x_("getpinproto"), 1, 1, EVAL);
1782 Define_Primitive((ELKObject(*)(ELLIPSIS))lsp_getnetwork, x_("getnetwork"), 2, 2, EVAL);
1783 }
1784
1785 #endif
1786