1 /*
2 * Copyright (c) 2002 by The XFree86 Project, Inc.
3 *
4 * Permission is hereby granted, free of charge, to any person obtaining a
5 * copy of this software and associated documentation files (the "Software"),
6 * to deal in the Software without restriction, including without limitation
7 * the rights to use, copy, modify, merge, publish, distribute, sublicense,
8 * and/or sell copies of the Software, and to permit persons to whom the
9 * Software is furnished to do so, subject to the following conditions:
10 *
11 * The above copyright notice and this permission notice shall be included in
12 * all copies or substantial portions of the Software.
13 *
14 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
15 * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
16 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
17 * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
18 * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
19 * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
20 * SOFTWARE.
21 *
22 * Except as contained in this notice, the name of the XFree86 Project shall
23 * not be used in advertising or otherwise to promote the sale, use or other
24 * dealings in this Software without prior written authorization from the
25 * XFree86 Project.
26 *
27 * Author: Paulo César Pereira de Andrade
28 */
29
30 /* $XFree86: xc/programs/xedit/lisp/package.c,v 1.20tsi Exp $ */
31
32 #include "lisp/package.h"
33 #include "lisp/private.h"
34
35 /*
36 * Prototypes
37 */
38 static int LispDoSymbol(LispObj*, LispAtom*, int, int);
39 static LispObj *LispReallyDoSymbols(LispBuiltin*, int, int);
40 static LispObj *LispDoSymbols(LispBuiltin*, int, int);
41 static LispObj *LispFindSymbol(LispBuiltin*, int);
42 static LispObj *LispFindPackageOrDie(LispBuiltin*, LispObj*);
43 static void LispDoExport(LispBuiltin*, LispObj*, LispObj*, int);
44 static void LispDoImport(LispBuiltin*, LispObj*);
45
46 /*
47 * Initialization
48 */
49 extern LispProperty *NOPROPERTY;
50 static LispObj *Kinternal, *Kexternal, *Kinherited;
51
52 /*
53 * Implementation
54 */
55 void
LispPackageInit(void)56 LispPackageInit(void)
57 {
58 Kinternal = KEYWORD("INTERNAL");
59 Kexternal = KEYWORD("EXTERNAL");
60 Kinherited = KEYWORD("INHERITED");
61 }
62
63 LispObj *
LispFindPackageFromString(const char * string)64 LispFindPackageFromString(const char *string)
65 {
66 LispObj *list, *package, *nick;
67
68 for (list = PACK; CONSP(list); list = CDR(list)) {
69 package = CAR(list);
70 if (strcmp(THESTR(package->data.package.name), string) == 0)
71 return (package);
72 for (nick = package->data.package.nicknames;
73 CONSP(nick); nick = CDR(nick))
74 if (strcmp(THESTR(CAR(nick)), string) == 0)
75 return (package);
76 }
77
78 return (NIL);
79 }
80
81 LispObj *
LispFindPackage(LispObj * name)82 LispFindPackage(LispObj *name)
83 {
84 char *string = NULL;
85
86 if (PACKAGEP(name))
87 return (name);
88
89 if (SYMBOLP(name))
90 string = ATOMID(name)->value;
91 else if (STRINGP(name))
92 string = THESTR(name);
93 else
94 LispDestroy("FIND-PACKAGE: %s is not a string or symbol", STROBJ(name));
95
96 return (LispFindPackageFromString(string));
97 }
98
99 int
LispCheckAtomString(const char * string)100 LispCheckAtomString(const char *string)
101 {
102 const char *ptr;
103
104 if (*string == '\0')
105 return (0);
106
107 for (ptr = string; *ptr; ptr++) {
108 if (islower(*ptr) || strchr("\"\\;#()`'|:", *ptr) ||
109 ((ptr == string || ptr[1] == '\0') && strchr(".,@", *ptr)))
110 return (0);
111 }
112
113 return (1);
114 }
115
116 /* This function is used to avoid some namespace polution caused by the
117 * way builtin functions are created, all function name arguments enter
118 * the current package, but most of them do not have a property */
119 static int
LispDoSymbol(LispObj * package,LispAtom * atom,int if_extern,int all_packages)120 LispDoSymbol(LispObj *package, LispAtom *atom, int if_extern, int all_packages)
121 {
122 int dosymbol;
123
124 /* condition 1: atom package is current package */
125 dosymbol = !all_packages || atom->package == package;
126 if (dosymbol) {
127 /* condition 2: intern and extern symbols or symbol is extern */
128 dosymbol = !if_extern || atom->ext;
129 if (dosymbol) {
130 /* condition 3: atom has properties or is in
131 * the current package */
132 dosymbol = atom->property != NOPROPERTY ||
133 package == lisp__data.keyword ||
134 package == PACKAGE;
135 }
136 }
137
138 return (dosymbol);
139 }
140
141 static LispObj *
LispFindPackageOrDie(LispBuiltin * builtin,LispObj * name)142 LispFindPackageOrDie(LispBuiltin *builtin, LispObj *name)
143 {
144 LispObj *package;
145
146 package = LispFindPackage(name);
147
148 if (package == NIL)
149 LispDestroy("%s: package %s is not available",
150 STRFUN(builtin), STROBJ(name));
151
152 return (package);
153 }
154
155 /* package must be of type LispPackage_t, symbol type is checked
156 bypass lisp.c:LispExportSymbol() */
157 static void
LispDoExport(LispBuiltin * builtin,LispObj * package,LispObj * symbol,int export)158 LispDoExport(LispBuiltin *builtin,
159 LispObj *package, LispObj *symbol, int export)
160 {
161 CHECK_SYMBOL(symbol);
162 if (!export) {
163 if (package == lisp__data.keyword ||
164 symbol->data.atom->package == lisp__data.keyword)
165 LispDestroy("%s: symbol %s cannot be unexported",
166 STRFUN(builtin), STROBJ(symbol));
167 }
168
169 if (package == PACKAGE)
170 symbol->data.atom->ext = export ? 1 : 0;
171 else {
172 Atom_id string;
173 LispAtom *atom;
174 LispPackage *pack;
175
176 string = ATOMID(symbol);
177 pack = package->data.package.package;
178 atom = (LispAtom *)hash_check(pack->atoms,
179 string->value, string->length);
180
181 if (atom) {
182 atom->ext = export ? 1 : 0;
183 return;
184 }
185
186 LispDestroy("%s: the symbol %s is not available in package %s",
187 STRFUN(builtin), STROBJ(symbol),
188 THESTR(package->data.package.name));
189 }
190 }
191
192 static void
LispDoImport(LispBuiltin * builtin,LispObj * symbol)193 LispDoImport(LispBuiltin *builtin, LispObj *symbol)
194 {
195 CHECK_SYMBOL(symbol);
196 LispImportSymbol(symbol);
197 }
198
199 static LispObj *
LispReallyDoSymbols(LispBuiltin * builtin,int only_externs,int all_symbols)200 LispReallyDoSymbols(LispBuiltin *builtin, int only_externs, int all_symbols)
201 {
202 int head = lisp__data.env.length;
203 LispPackage *pack = NULL;
204 LispAtom *atom;
205 LispObj *variable, *package = NULL, *list, *code, *result_form;
206
207 LispObj *init, *body;
208
209 body = ARGUMENT(1);
210 init = ARGUMENT(0);
211
212 /* Prepare for loop */
213 CHECK_CONS(init);
214 variable = CAR(init);
215 CHECK_SYMBOL(variable);
216
217 if (!all_symbols) {
218 /* if all_symbols, a package name is not specified in the init form */
219
220 init = CDR(init);
221 if (!CONSP(init))
222 LispDestroy("%s: missing package name", STRFUN(builtin));
223
224 /* Evaluate package specification */
225 package = EVAL(CAR(init));
226 if (!PACKAGEP(package))
227 package = LispFindPackageOrDie(builtin, package);
228
229 pack = package->data.package.package;
230 }
231
232 result_form = NIL;
233
234 init = CDR(init);
235 if (CONSP(init))
236 result_form = init;
237
238 /* Initialize iteration variable */
239 CHECK_CONSTANT(variable);
240 LispAddVar(variable, NIL);
241 ++lisp__data.env.head;
242
243 for (list = PACK; CONSP(list); list = CDR(list)) {
244 if (all_symbols) {
245 package = CAR(list);
246 pack = package->data.package.package;
247 }
248
249 /* Traverse the symbol list, executing body */
250 for (atom = (LispAtom *)hash_iter_first(pack->atoms);
251 atom;
252 atom = (LispAtom *)hash_iter_next(pack->atoms)) {
253 /* Save pointer to next atom. If variable is removed,
254 * predicatable result is only guaranteed if the bound
255 * variable is removed. */
256
257 if (LispDoSymbol(package, atom, only_externs, all_symbols)) {
258 LispSetVar(variable, atom->object);
259 for (code = body; CONSP(code); code = CDR(code))
260 EVAL(CAR(code));
261 }
262 }
263
264 if (!all_symbols)
265 break;
266 }
267
268 /* Variable is still bound */
269 for (code = result_form; CONSP(code); code = CDR(code))
270 EVAL(CAR(code));
271
272 lisp__data.env.head = lisp__data.env.length = head;
273
274 return (NIL);
275 }
276
277 static LispObj *
LispDoSymbols(LispBuiltin * builtin,int only_externs,int all_symbols)278 LispDoSymbols(LispBuiltin *builtin, int only_externs, int all_symbols)
279 {
280 int did_jump, *pdid_jump = &did_jump;
281 LispObj *result, **presult = &result;
282 LispBlock *block;
283
284 *presult = NIL;
285 *pdid_jump = 1;
286 block = LispBeginBlock(NIL, LispBlockTag);
287 if (setjmp(block->jmp) == 0) {
288 *presult = LispReallyDoSymbols(builtin, only_externs, all_symbols);
289 *pdid_jump = 0;
290 }
291 LispEndBlock(block);
292 if (*pdid_jump)
293 *presult = lisp__data.block.block_ret;
294
295 return (*presult);
296 }
297
298 LispObj *
LispFindSymbol(LispBuiltin * builtin,int intern)299 LispFindSymbol(LispBuiltin *builtin, int intern)
300 {
301 char *ptr;
302 LispAtom *atom;
303 LispObj *symbol;
304 LispPackage *pack;
305
306 LispObj *string, *package;
307
308 package = ARGUMENT(1);
309 string = ARGUMENT(0);
310
311 CHECK_STRING(string);
312 if (package != UNSPEC)
313 package = LispFindPackageOrDie(builtin, package);
314 else
315 package = PACKAGE;
316
317 /* If got here, package is a LispPackage_t */
318 pack = package->data.package.package;
319
320 /* Search symbol in specified package */
321 ptr = THESTR(string);
322
323 RETURN_COUNT = 1;
324
325 symbol = NULL;
326 /* Fix for current behaviour where NIL and T aren't symbols... */
327 if (STRLEN(string) == 3 && memcmp(ptr, "NIL", 3) == 0)
328 symbol = NIL;
329 else if (STRLEN(string) == 1 && ptr[0] == 'T')
330 symbol = T;
331 if (symbol) {
332 RETURN(0) = NIL;
333 return (symbol);
334 }
335
336 atom = (LispAtom *)hash_check(pack->atoms, ptr, strlen(ptr));
337 if (atom)
338 symbol = atom->object;
339
340 if (symbol == NULL || symbol->data.atom->package == NULL) {
341 RETURN(0) = NIL;
342 if (intern) {
343 /* symbol does not exist in the specified package, create a new
344 * internal symbol */
345
346 if (package == PACKAGE)
347 symbol = ATOM(ptr);
348 else {
349 LispPackage *savepack;
350 LispObj *savepackage;
351
352 /* Save package environment */
353 savepackage = PACKAGE;
354 savepack = lisp__data.pack;
355
356 /* Change package environment */
357 PACKAGE = package;
358 lisp__data.pack = package->data.package.package;
359
360 symbol = ATOM(ptr);
361
362 /* Restore package environment */
363 PACKAGE = savepackage;
364 lisp__data.pack = savepack;
365 }
366
367 symbol->data.atom->unreadable = !LispCheckAtomString(ptr);
368 /* If symbol being create in the keyword package, make it external */
369 if (package == lisp__data.keyword)
370 symbol->data.atom->ext = symbol->data.atom->constant = 1;
371 }
372 else
373 symbol = NIL;
374 }
375 else {
376 if (symbol->data.atom->package == package)
377 RETURN(0) = symbol->data.atom->ext ? Kexternal : Kinternal;
378 else
379 RETURN(0) = Kinherited;
380 }
381
382 return (symbol);
383 }
384
385
386 LispObj *
Lisp_DoAllSymbols(LispBuiltin * builtin)387 Lisp_DoAllSymbols(LispBuiltin *builtin)
388 /*
389 do-all-symbols init &rest body
390 */
391 {
392 return (LispDoSymbols(builtin, 0, 1));
393 }
394
395 LispObj *
Lisp_DoExternalSymbols(LispBuiltin * builtin)396 Lisp_DoExternalSymbols(LispBuiltin *builtin)
397 /*
398 do-external-symbols init &rest body
399 */
400 {
401 return (LispDoSymbols(builtin, 1, 0));
402 }
403
404 LispObj *
Lisp_DoSymbols(LispBuiltin * builtin)405 Lisp_DoSymbols(LispBuiltin *builtin)
406 /*
407 do-symbols init &rest body
408 */
409 {
410 return (LispDoSymbols(builtin, 0, 0));
411 }
412
413 LispObj *
Lisp_FindAllSymbols(LispBuiltin * builtin)414 Lisp_FindAllSymbols(LispBuiltin *builtin)
415 /*
416 find-all-symbols string-or-symbol
417 */
418 {
419 GC_ENTER();
420 char *string = NULL;
421 LispAtom *atom;
422 LispPackage *pack;
423 LispObj *list, *package, *result;
424 int length = 0;
425
426 LispObj *string_or_symbol;
427
428 string_or_symbol = ARGUMENT(0);
429
430 if (STRINGP(string_or_symbol)) {
431 string = THESTR(string_or_symbol);
432 length = STRLEN(string_or_symbol);
433 }
434 else if (SYMBOLP(string_or_symbol)) {
435 string = ATOMID(string_or_symbol)->value;
436 length = ATOMID(string_or_symbol)->length;
437 }
438 else
439 LispDestroy("%s: %s is not a string or symbol",
440 STRFUN(builtin), STROBJ(string_or_symbol));
441
442 result = NIL;
443
444 /* Traverse all packages, searching for symbols matching specified string */
445 for (list = PACK; CONSP(list); list = CDR(list)) {
446 package = CAR(list);
447 pack = package->data.package.package;
448
449 atom = (LispAtom *)hash_check(pack->atoms, string, length);
450 if (atom && LispDoSymbol(package, atom, 0, 1)) {
451 /* Return only one pointer to a matching symbol */
452
453 if (result == NIL) {
454 result = CONS(atom->object, NIL);
455 GC_PROTECT(result);
456 }
457 else {
458 /* Put symbols defined first in the
459 * beginning of the result list */
460 RPLACD(result, CONS(CAR(result), CDR(result)));
461 RPLACA(result, atom->object);
462 }
463 }
464 }
465 GC_LEAVE();
466
467 return (result);
468 }
469
470 LispObj *
Lisp_FindSymbol(LispBuiltin * builtin)471 Lisp_FindSymbol(LispBuiltin *builtin)
472 /*
473 find-symbol string &optional package
474 */
475 {
476 return (LispFindSymbol(builtin, 0));
477 }
478
479 LispObj *
Lisp_FindPackage(LispBuiltin * builtin)480 Lisp_FindPackage(LispBuiltin *builtin)
481 /*
482 find-package name
483 */
484 {
485 LispObj *name;
486
487 name = ARGUMENT(0);
488
489 return (LispFindPackage(name));
490 }
491
492 LispObj *
Lisp_Export(LispBuiltin * builtin)493 Lisp_Export(LispBuiltin *builtin)
494 /*
495 export symbols &optional package
496 */
497 {
498 LispObj *list;
499
500 LispObj *symbols, *package;
501
502 package = ARGUMENT(1);
503 symbols = ARGUMENT(0);
504
505 /* If specified, make sure package is available */
506 if (package != UNSPEC)
507 package = LispFindPackageOrDie(builtin, package);
508 else
509 package = PACKAGE;
510
511 /* Export symbols */
512 if (CONSP(symbols)) {
513 for (list = symbols; CONSP(list); list = CDR(list))
514 LispDoExport(builtin, package, CAR(list), 1);
515 }
516 else
517 LispDoExport(builtin, package, symbols, 1);
518
519 return (T);
520 }
521
522 LispObj *
Lisp_Import(LispBuiltin * builtin)523 Lisp_Import(LispBuiltin *builtin)
524 /*
525 import symbols &optional package
526 */
527 {
528 int restore_package;
529 LispPackage *savepack = NULL;
530 LispObj *list, *savepackage = NULL;
531
532 LispObj *symbols, *package;
533
534 package = ARGUMENT(1);
535 symbols = ARGUMENT(0);
536
537 /* If specified, make sure package is available */
538 if (package != UNSPEC)
539 package = LispFindPackageOrDie(builtin, package);
540 else
541 package = PACKAGE;
542
543 restore_package = package != PACKAGE;
544 if (restore_package) {
545 /* Save package environment */
546 savepackage = PACKAGE;
547 savepack = lisp__data.pack;
548
549 /* Change package environment */
550 PACKAGE = package;
551 lisp__data.pack = package->data.package.package;
552 }
553
554 /* Export symbols */
555 if (CONSP(symbols)) {
556 for (list = symbols; CONSP(list); list = CDR(list))
557 LispDoImport(builtin, CAR(list));
558 }
559 else
560 LispDoImport(builtin, symbols);
561
562 if (restore_package) {
563 /* Restore package environment */
564 PACKAGE = savepackage;
565 lisp__data.pack = savepack;
566 }
567
568 return (T);
569 }
570
571 LispObj *
Lisp_InPackage(LispBuiltin * builtin)572 Lisp_InPackage(LispBuiltin *builtin)
573 /*
574 in-package name
575 */
576 {
577 LispObj *package;
578
579 LispObj *name;
580
581 name = ARGUMENT(0);
582
583 package = LispFindPackageOrDie(builtin, name);
584
585 /* Update pointer to package symbol table */
586 lisp__data.pack = package->data.package.package;
587 PACKAGE = package;
588
589 return (package);
590 }
591
592 LispObj *
Lisp_Intern(LispBuiltin * builtin)593 Lisp_Intern(LispBuiltin *builtin)
594 /*
595 intern string &optional package
596 */
597 {
598 return (LispFindSymbol(builtin, 1));
599 }
600
601 LispObj *
Lisp_ListAllPackages(LispBuiltin * builtin)602 Lisp_ListAllPackages(LispBuiltin *builtin)
603 /*
604 list-all-packages
605 */
606 {
607 /* Maybe this should be read-only or a copy of the package list.
608 * But, if properly implemented, it should be possible to (rplaca)
609 * this variable from lisp code with no problems. Don't do it at home. */
610
611 return (PACK);
612 }
613
614 LispObj *
Lisp_MakePackage(LispBuiltin * builtin)615 Lisp_MakePackage(LispBuiltin *builtin)
616 /*
617 make-package package-name &key nicknames use
618 */
619 {
620 GC_ENTER();
621 LispObj *list, *package, *nicks, *cons, *savepackage;
622
623 LispObj *package_name, *nicknames, *use;
624
625 use = ARGUMENT(2);
626 nicknames = ARGUMENT(1);
627 package_name = ARGUMENT(0);
628
629 /* Check if package already exists */
630 package = LispFindPackage(package_name);
631 if (package != NIL)
632 /* FIXME: this should be a correctable error */
633 LispDestroy("%s: package %s already defined",
634 STRFUN(builtin), STROBJ(package_name));
635
636 /* Error checks done, package_name is either a symbol or string */
637 if (!XSTRINGP(package_name))
638 package_name = STRING(ATOMID(package_name)->value);
639
640 GC_PROTECT(package_name);
641
642 /* Check nicknames */
643 nicks = cons = NIL;
644 for (list = nicknames; CONSP(list); list = CDR(list)) {
645 package = LispFindPackage(CAR(list));
646 if (package != NIL)
647 /* FIXME: this should be a correctable error */
648 LispDestroy("%s: nickname %s matches package %s",
649 STRFUN(builtin), STROBJ(CAR(list)),
650 THESTR(package->data.package.name));
651 /* Store all nicknames as strings */
652 package = CAR(list);
653 if (!XSTRINGP(package))
654 package = STRING(ATOMID(package)->value);
655 if (nicks == NIL) {
656 nicks = cons = CONS(package, NIL);
657 GC_PROTECT(nicks);
658 }
659 else {
660 RPLACD(cons, CONS(package, NIL));
661 cons = CDR(cons);
662 }
663 }
664
665 /* Check use list */
666 for (list = use; CONSP(list); list = CDR(list))
667 (void)LispFindPackageOrDie(builtin, CAR(list));
668
669 /* No errors, create new package */
670 package = LispNewPackage(package_name, nicks);
671
672 /* Update list of packages */
673 PACK = CONS(package, PACK);
674
675 /* No need for gc protection anymore */
676 GC_LEAVE();
677
678 /* Import symbols from use list */
679 savepackage = PACKAGE;
680
681 /* Update pointer to package symbol table */
682 lisp__data.pack = package->data.package.package;
683 PACKAGE = package;
684
685 if (use != UNSPEC) {
686 for (list = use; CONSP(list); list = CDR(list))
687 LispUsePackage(LispFindPackage(CAR(list)));
688 }
689 else
690 LispUsePackage(lisp__data.lisp);
691
692 /* Restore pointer to package symbol table */
693 lisp__data.pack = savepackage->data.package.package;
694 PACKAGE = savepackage;
695
696 return (package);
697 }
698
699 LispObj *
Lisp_Packagep(LispBuiltin * builtin)700 Lisp_Packagep(LispBuiltin *builtin)
701 /*
702 packagep object
703 */
704 {
705 LispObj *object;
706
707 object = ARGUMENT(0);
708
709 return (PACKAGEP(object) ? T : NIL);
710 }
711
712 LispObj *
Lisp_PackageName(LispBuiltin * builtin)713 Lisp_PackageName(LispBuiltin *builtin)
714 /*
715 package-name package
716 */
717 {
718 LispObj *package;
719
720 package = ARGUMENT(0);
721
722 package = LispFindPackageOrDie(builtin, package);
723
724 return (package->data.package.name);
725 }
726
727 LispObj *
Lisp_PackageNicknames(LispBuiltin * builtin)728 Lisp_PackageNicknames(LispBuiltin *builtin)
729 /*
730 package-nicknames package
731 */
732 {
733 LispObj *package;
734
735 package = ARGUMENT(0);
736
737 package = LispFindPackageOrDie(builtin, package);
738
739 return (package->data.package.nicknames);
740 }
741
742 LispObj *
Lisp_PackageUseList(LispBuiltin * builtin)743 Lisp_PackageUseList(LispBuiltin *builtin)
744 /*
745 package-use-list package
746 */
747 {
748 /* If the variable returned by this function is expected to be changeable,
749 * need to change the layout of the LispPackage structure. */
750
751 LispPackage *pack;
752 LispObj *package, *use, *cons;
753
754 package = ARGUMENT(0);
755
756 package = LispFindPackageOrDie(builtin, package);
757
758 use = cons = NIL;
759 pack = package->data.package.package;
760
761 if (pack->use.length) {
762 GC_ENTER();
763 int i = pack->use.length - 1;
764
765 use = cons = CONS(pack->use.pairs[i], NIL);
766 GC_PROTECT(use);
767 for (--i; i >= 0; i--) {
768 RPLACD(cons, CONS(pack->use.pairs[i], NIL));
769 cons = CDR(cons);
770 }
771 GC_LEAVE();
772 }
773
774 return (use);
775 }
776
777 LispObj *
Lisp_PackageUsedByList(LispBuiltin * builtin)778 Lisp_PackageUsedByList(LispBuiltin *builtin)
779 /*
780 package-used-by-list package
781 */
782 {
783 GC_ENTER();
784 int i;
785 LispPackage *pack;
786 LispObj *package, *other, *used, *cons, *list;
787
788 package = ARGUMENT(0);
789
790 package = LispFindPackageOrDie(builtin, package);
791
792 used = cons = NIL;
793
794 for (list = PACK; CONSP(list); list = CDR(list)) {
795 other = CAR(list);
796 if (package == other)
797 /* Surely package uses itself */
798 continue;
799
800 pack = other->data.package.package;
801
802 for (i = 0; i < pack->use.length; i++) {
803 if (pack->use.pairs[i] == package) {
804 if (used == NIL) {
805 used = cons = CONS(other, NIL);
806 GC_PROTECT(used);
807 }
808 else {
809 RPLACD(cons, CONS(other, NIL));
810 cons = CDR(cons);
811 }
812 }
813 }
814 }
815
816 GC_LEAVE();
817
818 return (used);
819 }
820
821 LispObj *
Lisp_Unexport(LispBuiltin * builtin)822 Lisp_Unexport(LispBuiltin *builtin)
823 /*
824 unexport symbols &optional package
825 */
826 {
827 LispObj *list;
828
829 LispObj *symbols, *package;
830
831 package = ARGUMENT(1);
832 symbols = ARGUMENT(0);
833
834 /* If specified, make sure package is available */
835 if (package != UNSPEC)
836 package = LispFindPackageOrDie(builtin, package);
837 else
838 package = PACKAGE;
839
840 /* Export symbols */
841 if (CONSP(symbols)) {
842 for (list = symbols; CONSP(list); list = CDR(list))
843 LispDoExport(builtin, package, CAR(list), 0);
844 }
845 else
846 LispDoExport(builtin, package, symbols, 0);
847
848 return (T);
849 }
850