From 23ee878e5913f27d56325dc943049e67ab9f4e16 Mon Sep 17 00:00:00 2001 From: jjgarcia Date: Sun, 15 Sep 2002 13:29:05 +0000 Subject: [PATCH] All symbols belonging to the LISP package and to the C core, are kept in a single array, "cl_symbols". The translator "dpp" and the routine SI::MANGLE-NAME, output the right name for any symbol which is in this array. --- src/CHANGELOG | 27 +- src/c/Makefile.in | 14 +- src/c/all_functions.d | 851 +--------------------------------------- src/c/all_symbols.d | 400 +++---------------- src/c/alloc_2.d | 3 - src/c/array.d | 3 - src/c/assignment.d | 12 - src/c/backq.d | 34 +- src/c/cfun.d | 7 - src/c/clos.d | 3 - src/c/compiler.d | 27 +- src/c/dpp.c | 217 +++++------ src/c/error.d | 27 +- src/c/eval.d | 15 - src/c/file.d | 50 --- src/c/format.d | 4 +- src/c/functions_list.h | 853 +++++++++++++++++++++++++++++++++++++++++ src/c/gbc.d | 19 +- src/c/gfun.d | 16 +- src/c/hash.d | 9 - src/c/init.d | 1 - src/c/instance.d | 6 - src/c/interpreter.d | 2 +- src/c/list.d | 11 +- src/c/load.d | 15 +- src/c/lwp.d | 7 - src/c/macros.d | 5 - src/c/main.d | 14 +- src/c/num_comp.d | 7 - src/c/num_rand.d | 2 - src/c/package.d | 11 - src/c/pathname.d | 22 -- src/c/print.d | 51 +-- src/c/read.d | 158 ++++---- src/c/stacks.d | 2 - src/c/string.d | 7 - src/c/structure.d | 14 +- src/c/symbol.d | 40 +- src/c/symbols_list.h | 354 +++++++++++++++++ src/c/typespec.d | 99 ----- src/c/unixfsys.d | 2 - src/h/external.h | 5 +- src/h/object.h | 6 +- src/h/page.h | 25 -- 44 files changed, 1533 insertions(+), 1924 deletions(-) create mode 100644 src/c/functions_list.h create mode 100644 src/c/symbols_list.h diff --git a/src/CHANGELOG b/src/CHANGELOG index 2cde1f4cb..895a31df1 100644 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -887,6 +887,15 @@ ECL 0.6 - Code for handling :IMPORT-FROM in DEFPACKAGE was bogus + - The arguments of GENSYM should not be remembered by ECLS. The + current behaviour was wrong: + > (gensym) + #:G36 + > (gensym "F") + #:F37 + > (gensym) + #:F38 + * System design: - Function SI:NANI has been removed. Its purpose was to provide an @@ -907,9 +916,14 @@ ECL 0.6 structures. Now FORMAT is reentrant and can be safely called from within PRINT-OBJECT. + - All symbols belonging to the LISP package and to the C core, are + kept in a single array, "cl_symbols". The translator "dpp" and the + routine SI::MANGLE-NAME, output the right name for any symbol + which is in this array. + * Visible changes and ANSI compatibility: - - New configuration flag --with-clos-streams, enable the user to + - New configuration flag --with-clos-streams, enables the user to define CLOS objects which behave as lisp streams. Such object must have the following methods defined: STREAM-INPUT-P, STREAM-OUTPUT-P, STREAM-READ-CHAR, STREAM-UNREAD-CHAR, @@ -921,19 +935,12 @@ ECL 0.6 libraries. For example, (LOAD (OPEN "foo.lsp")) is equivalent to (LOAD "foo.lsp"). - - The arguments of GENSYM should not be remembered by ECLS. The - current behaviour is wrong: - > (gensym) - #:G36 - > (gensym "F") - #:F37 - > (gensym) - #:F38 - - ECL now uses a hashtable to store objects when *PRINT-CIRCLE* is on. This hashtable is not cleared when calling PRINT-OBJECT, so that circularities are also detected inside these methods. + - *PRINT-CIRCLE* defaults to NIL. + TODO: ===== diff --git a/src/c/Makefile.in b/src/c/Makefile.in index 4dad92dd9..421c9232e 100644 --- a/src/c/Makefile.in +++ b/src/c/Makefile.in @@ -43,7 +43,7 @@ OBJS = main.o symbol.o package.o list.o\ time.o unixint.o\ mapfun.o multival.o hash.o format.o pathname.o\ structure.o load.o unixfsys.o unixsys.o \ - all_keywords.o all_symbols.o all_functions.o init.o @EXTRA_OBJS@ + all_symbols.o all_functions.o init.o symbols_def.o @EXTRA_OBJS@ .SUFFIXES: .c .o .d @@ -67,8 +67,8 @@ clean: # Build rules -$(DPP): $(srcdir)/dpp.c - $(TRUE_CC) @CFLAGS@ -I$(HDIR) $(srcdir)/dpp.c -o $@ +$(DPP): $(srcdir)/dpp.c $(srcdir)/symbols_list.h $(srcdir)/functions_list.h + $(TRUE_CC) @CFLAGS@ -I../h -I$(HDIR) $(DEFS) $(srcdir)/dpp.c -o $@ # # Some files may break due to gcc optimizations @@ -77,6 +77,10 @@ $(DPP): $(srcdir)/dpp.c # dangerous to optimize due to assembler hack # $(CC) $(CFLAGS) -O0 -g apply.c -o $@ assignment.o: assignment.c $(HFILES) - $(CC) $(CFLAGS) -g assignment.c -o $@ + $(CC) $(CFLAGS) assignment.c -o $@ gbc.o: gbc.c $(HFILES) - $(CC) $(CFLAGS) -g gbc.c -o $@ + $(CC) $(CFLAGS) gbc.c -o $@ +symbols_def.o: $(srcdir)/symbols_list.h + echo '#include "ecl.h"' > symbols_def.c + cat $(srcdir)/symbols_list.h | grep 'SW("' | grep -v 'NULL[,)]' | sed 's/SW(".*&\([a-zA-Z_0-9]*\)),/cl_object \1;/g' >> symbols_def.c + $(CC) $(CFLAGS) symbols_def.c -o $@ diff --git a/src/c/all_functions.d b/src/c/all_functions.d index 5a8f03288..806f60f7b 100644 --- a/src/c/all_functions.d +++ b/src/c/all_functions.d @@ -3,859 +3,22 @@ #include "ecl.h" #include "page.h" -#define form 2 -#define cl 0 -#define si 1 - -const struct function_info all_functions[] = { - - /* alloc.c */ - -#if !defined(GBC_BOEHM) - {"ALLOCATE", siLallocate, si}, - {"ALLOCATED-PAGES", siLallocated_pages, si}, - {"MAXIMUM-ALLOCATABLE-PAGES", siLmaxpage, si}, - {"ALLOCATE-CONTIGUOUS-PAGES", siLalloc_contpage, si}, - {"ALLOCATED-CONTIGUOUS-PAGES", siLncbpage, si}, - {"MAXIMUM-CONTIGUOUS-PAGES", siLmaxcbpage, si}, - {"GET-HOLE-SIZE", siLget_hole_size, si}, - {"SET-HOLE-SIZE", siLset_hole_size, si}, - {"IGNORE-MAXIMUM-PAGES", siLignore_maximum_pages, si}, -#endif /* !GBC_BOEHM */ - - /* alloc_2.c */ - -#ifdef GBC_BOEHM - {"GC", clLgc, cl}, -#endif - - /* all_symbols.c */ - - {"MANGLE-NAME", siLmangle_name, si}, - - /* array.c */ - - {"MAKE-PURE-ARRAY", siLmake_pure_array, si}, - {"MAKE-VECTOR", siLmake_vector, si}, - {"AREF", clLaref, cl}, - {"ASET", siLaset, si}, - {"ARRAY-ELEMENT-TYPE", clLarray_element_type, cl}, - {"ARRAY-RANK", clLarray_rank, cl}, - {"ARRAY-DIMENSION", clLarray_dimension, cl}, - {"ARRAY-TOTAL-SIZE", clLarray_total_size, cl}, - {"ADJUSTABLE-ARRAY-P", clLadjustable_array_p, cl}, - {"DISPLACED-ARRAY-P", siLdisplaced_array_p, si}, - {"ROW-MAJOR-AREF", clLrow_major_aref, cl}, - {"ROW-MAJOR-ASET", siLrow_major_aset, si}, - - {"SVREF", clLsvref, cl}, - {"SVSET", siLsvset, si}, - - {"ARRAY-HAS-FILL-POINTER-P", clLarray_has_fill_pointer_p, cl}, - {"FILL-POINTER", clLfill_pointer, cl}, - {"FILL-POINTER-SET", siLfill_pointer_set, si}, - - {"REPLACE-ARRAY", siLreplace_array, si}, - - /* assignment.c */ - - {"CLEAR-COMPILER-PROPERTIES", siLclear_compiler_properties, si}, - {"SETQ", NULL, form}, - {"PSETQ", NULL, form}, - {"SET", clLset, cl}, - {"FSET", siLfset, si}, - {"MULTIPLE-VALUE-SETQ", NULL, form}, - {"MAKUNBOUND", clLmakunbound, cl}, - {"FMAKUNBOUND", clLfmakunbound, cl}, -#if 0 - {"SETF", NULL, form}, - {"PUSH", NULL, form}, - {"POP", NULL, form}, - {"INCF", NULL, form}, - {"DECF", NULL, form}, -#endif - {"SETF-NAMEP", siLsetf_namep, si}, - - /* block.c */ - - {"BLOCK", NULL, form}, - {"RETURN-FROM", NULL, form}, - {"RETURN", NULL, form}, - - /* catch.c */ - - {"CATCH", NULL, form}, - {"UNWIND-PROTECT", NULL, form}, - {"THROW", NULL, form}, - - /* cfun.c */ - - {"COMPILED-FUNCTION-NAME", siLcompiled_function_name, si}, - {"COMPILED-FUNCTION-BLOCK", siLcompiled_function_block, si}, - {"COMPILED-FUNCTION-SOURCE", siLcompiled_function_source, si}, - - /* character.d */ - - {"STANDARD-CHAR-P", clLstandard_char_p, cl}, - {"GRAPHIC-CHAR-P", clLgraphic_char_p, cl}, - {"ALPHA-CHAR-P", clLalpha_char_p, cl}, - {"UPPER-CASE-P", clLupper_case_p, cl}, - {"LOWER-CASE-P", clLlower_case_p, cl}, - {"BOTH-CASE-P", clLboth_case_p, cl}, - {"DIGIT-CHAR-P", clLdigit_char_p, cl}, - {"ALPHANUMERICP", clLalphanumericp, cl}, - {"CHAR=", clLcharE, cl}, - {"CHAR/=", clLcharNE, cl}, - {"CHAR<", clLcharL, cl}, - {"CHAR>", clLcharG, cl}, - {"CHAR<=", clLcharLE, cl}, - {"CHAR>=", clLcharGE, cl}, - {"CHAR-EQUAL", clLchar_equal, cl}, - {"CHAR-NOT-EQUAL", clLchar_not_equal, cl}, - {"CHAR-LESSP", clLchar_lessp, cl}, - {"CHAR-GREATERP", clLchar_greaterp, cl}, - {"CHAR-NOT-GREATERP", clLchar_not_greaterp, cl}, - {"CHAR-NOT-LESSP", clLchar_not_lessp, cl}, - {"CHARACTER", clLcharacter, cl}, - {"CHAR-CODE", clLchar_code, cl}, - {"CODE-CHAR", clLcode_char, cl}, - {"CHAR-UPCASE", clLchar_upcase, cl}, - {"CHAR-DOWNCASE", clLchar_downcase, cl}, - {"DIGIT-CHAR", clLdigit_char, cl}, - {"CHAR-INT", clLchar_int, cl}, - {"INT-CHAR", clLint_char, cl}, - {"CHAR-NAME", clLchar_name, cl}, - {"NAME-CHAR", clLname_char, cl}, - - /* clos.c */ - {"FIND-CLASS", clLfind_class, cl}, - - /* cmpaux.c */ - - {"SPECIALP", siLspecialp, si}, - - /* conditional.c */ - - {"IF", NULL, form}, - {"COND", NULL, form}, - {"CASE", NULL, form}, - {"WHEN", NULL, form}, - {"UNLESS", NULL, form}, - - /* disassembler.c */ - {"BC-DISASSEMBLE", siLbc_disassemble, si}, - {"BC-SPLIT", siLbc_split, si}, - - /* error.c */ - - {"ERROR", clLerror, cl}, - {"CERROR", clLcerror, cl}, - - /* eval.c */ - - {"EVAL", clLeval, cl}, - {"EVAL-WITH-ENV", siLeval_with_env, si}, - {"CONSTANTP", clLconstantp, cl}, - {"UNLINK-SYMBOL", siLunlink_symbol, si}, - {"APPLY", clLapply, cl}, - {"FUNCALL", clLfuncall, cl}, - - /* file.d */ - - {"MAKE-SYNONYM-STREAM", clLmake_synonym_stream, cl}, - {"MAKE-BROADCAST-STREAM", clLmake_broadcast_stream, cl}, - {"MAKE-CONCATENATED-STREAM", clLmake_concatenated_stream, cl}, - {"MAKE-TWO-WAY-STREAM", clLmake_two_way_stream, cl}, - {"MAKE-ECHO-STREAM", clLmake_echo_stream, cl}, - {"MAKE-STRING-INPUT-STREAM", clLmake_string_input_stream, cl}, - {"MAKE-STRING-OUTPUT-STREAM", clLmake_string_output_stream, cl}, - {"GET-OUTPUT-STREAM-STRING", clLget_output_stream_string, cl}, - - {"OUTPUT-STREAM-STRING", siLoutput_stream_string, si}, - - {"STREAMP", clLstreamp, cl}, - {"INPUT-STREAM-P", clLinput_stream_p, cl}, - {"OUTPUT-STREAM-P", clLoutput_stream_p, cl}, - {"STREAM-ELEMENT-TYPE", clLstream_element_type, cl}, - {"CLOSE", clLclose, cl}, - {"OPEN", clLopen, cl}, - {"FILE-POSITION", clLfile_position, cl}, - {"FILE-LENGTH", clLfile_length, cl}, - {"OPEN-STREAM-P", clLopen_stream_p, cl}, - {"GET-STRING-INPUT-STREAM-INDEX", siLget_string_input_stream_index, si}, - {"MAKE-STRING-OUTPUT-STREAM-FROM-STRING", siLmake_string_output_stream_from_string, si}, - {"COPY-STREAM", siLcopy_stream, si}, - - /* format. c */ - - {"FORMAT", clLformat, cl}, - - /* gbc.c */ - -#if !defined(GBC_BOEHM) - {"ROOM-REPORT", siLroom_report, si}, - {"RESET-GC-COUNT", siLreset_gc_count, si}, - {"GC", clLgc, cl}, - {"GC-TIME", siLgc_time, si}, -#endif - - /* gfun.c */ -#ifdef CLOS - {"ALLOCATE-GFUN", siLallocate_gfun, si}, - {"GFUN-NAME", siLgfun_name, si}, - {"GFUN-NAME-SET", siLgfun_name_set, si}, - {"GFUN-METHOD-HT", siLgfun_method_ht, si}, - {"GFUN-METHOD-HT-SET", siLgfun_method_ht_set, si}, - {"GFUN-SPEC-HOW-REF", siLgfun_spec_how_ref, si}, - {"GFUN-SPEC-HOW-SET", siLgfun_spec_how_set, si}, - {"GFUN-INSTANCE", siLgfun_instance, si}, - {"GFUN-INSTANCE-SET", siLgfun_instance_set, si}, - {"GFUNP", siLgfunp, si}, - {"METHOD-HT-GET", siLmethod_ht_get, si}, - {"SET-COMPILED-FUNCTION-NAME", siLset_compiled_function_name, si}, -#endif /* CLOS */ - - /* hash.d */ - - {"MAKE-HASH-TABLE", clLmake_hash_table, cl}, - {"HASH-TABLE-P", clLhash_table_p, cl}, - {"GETHASH", clLgethash, cl}, - {"REMHASH", clLremhash, cl}, - {"MAPHASH", clLmaphash, cl}, - {"CLRHASH", clLclrhash, cl}, - {"HASH-TABLE-COUNT", clLhash_table_count, cl}, - {"SXHASH", clLsxhash, cl}, - {"HASH-SET", siLhash_set, si}, - {"HASH-TABLE-REHASH-SIZE", clLhash_table_rehash_size, cl}, - {"HASH-TABLE-REHASH-THRESHOLD", clLhash_table_rehash_threshold, cl}, - - /* instance.c */ -#ifdef CLOS - {"ALLOCATE-INSTANCE", siLallocate_instance, si}, - {"CHANGE-INSTANCE", siLchange_instance, si}, - {"INSTANCE-REF-SAFE", siLinstance_ref_safe, si}, - {"INSTANCE-REF", siLinstance_ref, si}, - {"INSTANCE-SET", siLinstance_set, si}, - {"INSTANCE-CLASS", siLinstance_class, si}, - {"INSTANCE-CLASS-SET", siLinstance_class_set, si}, - {"INSTANCEP", siLinstancep, si}, - {"UNBOUND", siLunbound, si}, - {"SL-BOUNDP", siLsl_boundp, si}, - {"SL-MAKUNBOUND", siLsl_makunbound, si}, -#endif /* CLOS */ - - /* interpreter.c */ - {"INTERPRETER-STACK", siLinterpreter_stack, si}, - {"MAKE-LAMBDA", siLmake_lambda, si}, - {"FUNCTION-BLOCK-NAME", siLfunction_block_name, si}, - - /* iteration.c */ - - {"DO", NULL, form}, - {"DO*", NULL, form}, - {"DOLIST", NULL, form}, - {"DOTIMES", NULL, form}, - - /* let.c */ - - {"LET", NULL, form}, - {"LET*", NULL, form}, - {"MULTIPLE-VALUE-BIND", NULL, form}, - {"COMPILER-LET", NULL, form}, - {"FLET", NULL, form}, - {"LABELS", NULL, form}, - {"MACROLET", NULL, form}, - {"SYMBOL-MACROLET", NULL, form}, - - /* list.d */ - - {"CAR", clLcar, cl}, - {"CDR", clLcdr, cl}, - {"CAAR", clLcaar, cl}, - {"CADR", clLcadr, cl}, - {"CDAR", clLcdar, cl}, - {"CDDR", clLcddr, cl}, - {"CAAAR", clLcaaar, cl}, - {"CAADR", clLcaadr, cl}, - {"CADAR", clLcadar, cl}, - {"CADDR", clLcaddr, cl}, - {"CDAAR", clLcdaar, cl}, - {"CDADR", clLcdadr, cl}, - {"CDDAR", clLcddar, cl}, - {"CDDDR", clLcdddr, cl}, - {"CAAAAR", clLcaaaar, cl}, - {"CAAADR", clLcaaadr, cl}, - {"CAADAR", clLcaadar, cl}, - {"CAADDR", clLcaaddr, cl}, - {"CADAAR", clLcadaar, cl}, - {"CADADR", clLcadadr, cl}, - {"CADDAR", clLcaddar, cl}, - {"CADDDR", clLcadddr, cl}, - {"CDAAAR", clLcdaaar, cl}, - {"CDAADR", clLcdaadr, cl}, - {"CDADAR", clLcdadar, cl}, - {"CDADDR", clLcdaddr, cl}, - {"CDDAAR", clLcddaar, cl}, - {"CDDADR", clLcddadr, cl}, - {"CDDDAR", clLcdddar, cl}, - {"CDDDDR", clLcddddr, cl}, - - {"CONS", clLcons, cl}, - {"TREE-EQUAL", clLtree_equal, cl}, - {"ENDP", clLendp, cl}, - {"LIST-LENGTH", clLlist_length, cl}, - {"NTH", clLnth, cl}, - - {"FIRST", clLcar, cl}, - {"SECOND", clLcadr, cl}, - {"THIRD", clLcaddr, cl}, - {"FOURTH", clLcadddr, cl}, - {"FIFTH", clLfifth, cl}, - {"SIXTH", clLsixth, cl}, - {"SEVENTH", clLseventh, cl}, - {"EIGHTH", clLeighth, cl}, - {"NINTH", clLninth, cl}, - {"TENTH", clLtenth, cl}, - - {"REST", clLcdr, cl}, - {"NTHCDR", clLnthcdr, cl}, - {"LAST", clLlast, cl}, - {"LIST", clLlist, cl}, - {"LIST*", clLlistX, cl}, - {"MAKE-LIST", clLmake_list, cl}, - {"APPEND", clLappend, cl}, - {"COPY-LIST", clLcopy_list, cl}, - {"COPY-ALIST", clLcopy_alist, cl}, - {"COPY-TREE", clLcopy_tree, cl}, - {"REVAPPEND", clLrevappend, cl}, - {"NCONC", clLnconc, cl}, - {"NRECONC", clLnreconc, cl}, - - {"BUTLAST", clLbutlast, cl}, - {"NBUTLAST", clLnbutlast, cl}, - {"LDIFF", clLldiff, cl}, - {"RPLACA", clLrplaca, cl}, - {"RPLACD", clLrplacd, cl}, - {"SUBST", clLsubst, cl}, - {"SUBST-IF", clLsubst_if, cl}, - {"SUBST-IF-NOT", clLsubst_if_not, cl}, - {"NSUBST", clLnsubst, cl}, - {"NSUBST-IF", clLnsubst_if, cl}, - {"NSUBST-IF-NOT", clLnsubst_if_not, cl}, - {"SUBLIS", clLsublis, cl}, - {"NSUBLIS", clLnsublis, cl}, - {"MEMBER", clLmember, cl}, - {"MEMBER-IF", clLmember_if, cl}, - {"MEMBER-IF-NOT", clLmember_if_not, cl}, - {"MEMBER1", siLmember1, si}, - {"TAILP", clLtailp, cl}, - {"ADJOIN", clLadjoin, cl}, - - {"ACONS", clLacons, cl}, - {"PAIRLIS", clLpairlis, cl}, - {"ASSOC", clLassoc, cl}, - {"ASSOC-IF", clLassoc_if, cl}, - {"ASSOC-IF-NOT", clLassoc_if_not, cl}, - {"RASSOC", clLrassoc, cl}, - {"RASSOC-IF", clLrassoc_if, cl}, - {"RASSOC-IF-NOT", clLrassoc_if_not, cl}, - - {"MEMQ", siLmemq, si}, - - /* load.d */ - - {"LOAD", clLload, cl}, -#ifdef ENABLE_DLOPEN - {"LOAD-BINARY", siLload_binary, si}, -#endif - {"LOAD-SOURCE", siLload_source, si}, - - /* lwp.d */ -#ifdef THREADS - {"THREAD-BREAK-IN", siLthread_break_in, si}, - {"THREAD-BREAK-QUIT", siLthread_break_quit, si}, - {"THREAD-BREAK-RESUME", siLthread_break_resume, si}, - {"MAKE-THREAD", clLmake_thread, cl}, - {"DEACTIVATE", clLdeactivate, cl}, - {"REACTIVATE", clLreactivate, cl}, - {"KILL-THREAD", clLkill_thread, cl}, - {"CURRENT-THREAD", clLcurrent_thread, cl}, - {"THREAD-STATUS", clLthread_status, cl}, - {"THREAD-LIST", clLthread_list, cl}, - {"MAKE-CONTINUATION", clLmake_continuation, cl}, - {"THREAD-OF", clLthread_of, cl}, - {"CONTINUATION-OF", clLcontinuation_of, cl}, - {"RESUME", clLresume, cl}, - - {"%DISABLE-SCHEDULER", clLdisable_scheduler, cl}, - {"%ENABLE-SCHEDULER", clLenable_scheduler, cl}, - {"%SUSPEND", clLsuspend, cl}, - {"%DELAY", clLdelay, cl}, - {"%THREAD-WAIT", clLthread_wait, cl}, - {"%THREAD-WAIT-WITH-TIMEOUT", clLthread_wait_with_timeout, cl}, -#endif /* THREADS */ - - /* macros.c */ - - {"MACROEXPAND", clLmacroexpand, cl}, - {"MACROEXPAND-1", clLmacroexpand_1, cl}, - - /* main.c */ - - {"QUIT", clLquit, cl}, - {"ARGC", siLargc, si}, - {"ARGV", siLargv, si}, - {"GETENV", siLgetenv, si}, - {"SETENV", siLsetenv, si}, - {"POINTER", siLpointer, si}, - - /* mapfun.c */ - - {"MAPCAR", clLmapcar, cl}, - {"MAPLIST", clLmaplist, cl}, - {"MAPC", clLmapc, cl}, - {"MAPL", clLmapl, cl}, - {"MAPCAN", clLmapcan, cl}, - {"MAPCON", clLmapcon, cl}, - - /* multival.c */ - - {"VALUES", clLvalues, cl}, - {"VALUES-LIST", clLvalues_list, cl}, - {"MULTIPLE-VALUE-CALL", NULL, form}, - {"MULTIPLE-VALUE-PROG1", NULL, form}, - {"MULTIPLE-VALUE-LIST", NULL, form}, - {"NTH-VALUE", NULL, form}, - - - /* num-arith.c */ - - {"+", clLP, cl}, - {"-", clLM, cl}, - {"*", clLX, cl}, - {"/", clLN, cl}, - {"1+", clL1P, cl}, - {"1-", clL1M, cl}, - {"CONJUGATE", clLconjugate, cl}, - {"GCD", clLgcd, cl}, - {"LCM", clLlcm, cl}, - - - /* num_co.c */ - - {"FLOAT", clLfloat, cl}, - {"NUMERATOR", clLnumerator, cl}, - {"DENOMINATOR", clLdenominator, cl}, - {"FLOOR", clLfloor, cl}, - {"CEILING", clLceiling, cl}, - {"TRUNCATE", clLtruncate, cl}, - {"ROUND", clLround, cl}, - {"MOD", clLmod, cl}, - {"REM", clLrem, cl}, - {"DECODE-FLOAT", clLdecode_float, cl}, - {"SCALE-FLOAT", clLscale_float, cl}, - {"FLOAT-RADIX", clLfloat_radix, cl}, - {"FLOAT-SIGN", clLfloat_sign, cl}, - {"FLOAT-DIGITS", clLfloat_digits, cl}, - {"FLOAT-PRECISION", clLfloat_precision, cl}, - {"INTEGER-DECODE-FLOAT", clLinteger_decode_float, cl}, - {"COMPLEX", clLcomplex, cl}, - {"REALPART", clLrealpart, cl}, - {"IMAGPART", clLimagpart, cl}, - - /* num_comp.c */ - - {"=", clLE, cl}, - {"/=", clLNE, cl}, - {"<", clLL, cl}, - {">", clLG, cl}, - {"<=", clLLE, cl}, - {">=", clLGE, cl}, - {"MAX", clLmax, cl}, - {"MIN", clLmin, cl}, - - /* num_log.c */ - - {"LOGIOR", clLlogior, cl}, - {"LOGXOR", clLlogxor, cl}, - {"LOGAND", clLlogand, cl}, - {"LOGEQV", clLlogeqv, cl}, - {"LOGNAND", clLlognand, cl}, - {"LOGNOR", clLlognor, cl}, - {"LOGANDC1", clLlogandc1, cl}, - {"LOGANDC2", clLlogandc1, cl}, - {"LOGORC1", clLlogorc1, cl}, - {"LOGORC2", clLlogorc2, cl}, - {"LOGNOT", clLlognot, cl}, - {"BOOLE", clLboole, cl}, - {"LOGBITP", clLlogbitp, cl}, - {"ASH", clLash, cl}, - {"LOGCOUNT", clLlogcount, cl}, - {"INTEGER-LENGTH", clLinteger_length, cl}, - {"BIT-ARRAY-OP", siLbit_array_op, si}, - - /* num_pred.c */ - - {"ZEROP", clLzerop, cl}, - {"PLUSP", clLplusp, cl}, - {"MINUSP", clLminusp, cl}, - {"ODDP", clLoddp, cl}, - {"EVENP", clLevenp, cl}, - - /* num_rand.c */ - - {"RANDOM", clLrandom, cl}, - {"MAKE-RANDOM-STATE", clLmake_random_state, cl}, - {"RANDOM-STATE-P", clLrandom_state_p, cl}, - - /* num_sfun.c */ - - {"EXP", clLexp, cl}, - {"EXPT", clLexpt, cl}, - {"LOG", clLlog, cl}, - {"SQRT", clLsqrt, cl}, - {"SIN", clLsin, cl}, - {"COS", clLcos, cl}, - {"TAN", clLtan, cl}, - {"ATAN", clLatan, cl}, - {"SINH", clLsinh, cl}, - {"COSH", clLcosh, cl}, - {"TANH", clLtanh, cl}, - - /* package.d */ - - {"MAKE-PACKAGE", clLmake_package, cl}, - {"SELECT-PACKAGE", siLselect_package, si}, - {"FIND-PACKAGE", clLfind_package, cl}, - {"PACKAGE-NAME", clLpackage_name, cl}, - {"PACKAGE-NICKNAMES", clLpackage_nicknames, cl}, - {"RENAME-PACKAGE", clLrename_package, cl}, - {"PACKAGE-USE-LIST", clLpackage_use_list, cl}, - {"PACKAGE-USED-BY-LIST", clLpackage_used_by_list, cl}, - {"PACKAGE-SHADOWING-SYMBOLS", clLpackage_shadowing_symbols, cl}, - {"LIST-ALL-PACKAGES", clLlist_all_packages, cl}, - {"INTERN", clLintern, cl}, - {"FIND-SYMBOL", clLfind_symbol, cl}, - {"UNINTERN", clLunintern, cl}, - {"EXPORT", clLexport, cl}, - {"UNEXPORT", clLunexport, cl}, - {"IMPORT", clLimport, cl}, - {"SHADOWING-IMPORT", clLshadowing_import, cl}, - {"SHADOW", clLshadow, cl}, - {"USE-PACKAGE", clLuse_package, cl}, - {"UNUSE-PACKAGE", clLunuse_package, cl}, - {"DELETE-PACKAGE", clLdelete_package, cl}, - - {"PACKAGE-SIZE", siLpackage_size, si}, - {"PACKAGE-INTERNAL", siLpackage_internal, si}, - {"PACKAGE-EXTERNAL", siLpackage_external, si}, - {"PACKAGE-LOCK", siLpackage_lock, si}, - - /* pathname.d */ - - {"PATHNAME", clLpathname, cl}, - {"PARSE-NAMESTRING", clLparse_namestring, cl}, - {"MERGE-PATHNAMES", clLmerge_pathnames, cl}, - {"MAKE-PATHNAME", clLmake_pathname, cl}, - {"PATHNAMEP", clLpathnamep, cl}, - {"PATHNAME-HOST", clLpathname_host, cl}, - {"PATHNAME-DEVICE", clLpathname_device, cl}, - {"PATHNAME-DIRECTORY", clLpathname_directory, cl}, - {"PATHNAME-NAME", clLpathname_name, cl}, - {"PATHNAME-TYPE", clLpathname_type, cl}, - {"PATHNAME-VERSION", clLpathname_version, cl}, - {"NAMESTRING", clLnamestring, cl}, - {"FILE-NAMESTRING", clLfile_namestring, cl}, - {"DIRECTORY-NAMESTRING", clLdirectory_namestring, cl}, - {"HOST-NAMESTRING", clLhost_namestring, cl}, - {"ENOUGH-NAMESTRING", clLenough_namestring, cl}, - {"LOGICAL-PATHNAME-P", siLlogical_pathname_p, si}, - {"PATHNAME-MATCH-P", clLpathname_match_p, cl}, - {"TRANSLATE-PATHNAME", clLtranslate_pathname, cl}, - {"TRANSLATE-LOGICAL-PATHNAME", clLtranslate_logical_pathname, cl}, - {"PATHNAME-TRANSLATIONS", siLpathname_translations, si}, - - /* predicate.c */ - - {"IDENTITY", clLidentity, cl}, - {"NULL", clLnull, cl}, - {"SYMBOLP", clLsymbolp, cl}, - {"ATOM", clLatom, cl}, - {"CONSP", clLconsp, cl}, - {"LISTP", clLlistp, cl}, - {"NUMBERP", clLnumberp, cl}, - {"INTEGERP", clLintegerp, cl}, - {"RATIONALP", clLrationalp, cl}, - {"FLOATP", clLfloatp, cl}, - {"REALP", clLrealp, cl}, - {"COMPLEXP", clLcomplexp, cl}, - {"CHARACTERP", clLcharacterp, cl}, - {"STRINGP", clLstringp, cl}, - {"BIT-VECTOR-P", clLbit_vector_p, cl}, - {"VECTORP", clLvectorp, cl}, - {"SIMPLE-STRING-P", clLsimple_string_p, cl}, - {"SIMPLE-BIT-VECTOR-P", clLsimple_bit_vector_p, cl}, - {"SIMPLE-VECTOR-P", clLsimple_vector_p, cl}, - {"ARRAYP", clLarrayp, cl}, - {"PACKAGEP", clLpackagep, cl}, - {"FUNCTIONP", clLfunctionp, cl}, - {"COMPILED-FUNCTION-P", clLcompiled_function_p, cl}, - {"COMMONP", clLcommonp, cl}, - - {"EQ", clLeq, cl}, - {"EQL", clLeql, cl}, - {"EQUAL", clLequal, cl}, - {"EQUALP", clLequalp, cl}, - - {"NOT", clLnull, cl}, - - {"FIXNUMP", siLfixnump, si}, - - /* print.d */ - - {"WRITE", clLwrite, cl}, - {"PRIN1", clLprin1, cl}, - {"PRINT", clLprint, cl}, - {"PPRINT", clLpprint, cl}, - {"PRINC", clLprinc, cl}, - {"WRITE-CHAR", clLwrite_char, cl}, - {"WRITE-STRING", clLwrite_string, cl}, - {"WRITE-LINE", clLwrite_line, cl}, - {"WRITE-BYTE", clLwrite_byte, cl}, - {"WRITE-BYTES", siLwrite_bytes, si}, - {"TERPRI", clLterpri, cl}, - {"FRESH-LINE", clLfresh_line, cl}, - {"FINISH-OUTPUT", clLforce_output, cl}, - {"FORCE-OUTPUT", clLforce_output, cl}, - {"CLEAR-OUTPUT", clLclear_output, cl}, - - /* profile.c */ -#ifdef PROFILE - {"PROFILE", siLprofile, si}, - {"CLEAR-PROFILE", siLclear_profile, si}, - {"DISPLAY-PROFILE", siLdisplay_profile, si}, -#endif /* PROFILE */ - - /* prog.c */ - - {"TAGBODY", NULL, form}, - {"PROG", NULL, form}, - {"PROG*", NULL, form}, - {"GO", NULL, form}, - {"PROGV", NULL, form}, - {"PROGN", NULL, form}, - {"PROG1", NULL, form}, - {"PROG2", NULL, form}, - - /* read.d */ - - {"READ", clLread, cl}, - {"READ-PRESERVING-WHITESPACE", clLread_preserving_whitespace, cl}, - {"READ-DELIMITED-LIST", clLread_delimited_list, cl}, - {"READ-LINE", clLread_line, cl}, - {"READ-CHAR", clLread_char, cl}, - {"UNREAD-CHAR", clLunread_char, cl}, - {"PEEK-CHAR", clLpeek_char, cl}, - {"LISTEN", clLlisten, cl}, - {"READ-CHAR-NO-HANG", clLread_char_no_hang, cl}, - {"CLEAR-INPUT", clLclear_input, cl}, - - {"PARSE-INTEGER", clLparse_integer, cl}, - - {"READ-BYTE", clLread_byte, cl}, - {"READ-BYTES", siLread_bytes, si}, - - {"COPY-READTABLE", clLcopy_readtable, cl}, - {"READTABLEP", clLreadtablep, cl}, - {"SET-SYNTAX-FROM-CHAR", clLset_syntax_from_char, cl}, - {"SET-MACRO-CHARACTER", clLset_macro_character, cl}, - {"GET-MACRO-CHARACTER", clLget_macro_character, cl}, - {"MAKE-DISPATCH-MACRO-CHARACTER", clLmake_dispatch_macro_character, cl}, - {"SET-DISPATCH-MACRO-CHARACTER", clLset_dispatch_macro_character, cl}, - {"GET-DISPATCH-MACRO-CHARACTER", clLget_dispatch_macro_character, cl}, - {"STRING-TO-OBJECT", siLstring_to_object, si}, - {"STANDARD-READTABLE", siLstandard_readtable, si}, - - /* reference.c */ - - {"SYMBOL-FUNCTION", clLsymbol_function, cl}, - {"FBOUNDP", clLfboundp, cl}, - {"QUOTE", NULL, form}, - {"SYMBOL-VALUE", clLsymbol_value, cl}, - {"BOUNDP", clLboundp, cl}, - {"MACRO-FUNCTION", clLmacro_function, cl}, - {"SPECIAL-FORM-P", clLspecial_form_p, cl}, - {"COERCE-TO-FUNCTION", siLcoerce_to_function, si}, - {"FUNCTION", NULL, form}, - {"PROCESS-DECLARATIONS", siLprocess_declarations, si}, - {"PROCESS-LAMBDA-LIST", siLprocess_lambda_list, si}, - - /* sequence.d */ - - {"ELT", clLelt, cl}, - {"ELT-SET", siLelt_set, si}, - {"SUBSEQ", clLsubseq, cl}, - {"COPY-SEQ", clLcopy_seq, cl}, - {"LENGTH", clLlength, cl}, - {"REVERSE", clLreverse, cl}, - {"NREVERSE", clLnreverse, cl}, - - /* stacks.c */ - - {"IHS-TOP", siLihs_top, si}, - {"IHS-FUN", siLihs_fun, si}, - {"IHS-ENV", siLihs_env, si}, - {"IHS-NEXT", siLihs_next, si}, - {"IHS-PREV", siLihs_prev, si}, - {"FRS-TOP", siLfrs_top, si}, - {"FRS-BDS", siLfrs_bds, si}, - {"FRS-CLASS", siLfrs_class, si}, - {"FRS-TAG", siLfrs_tag, si}, - {"FRS-IHS", siLfrs_ihs, si}, - {"BDS-TOP", siLbds_top, si}, - {"BDS-VAR", siLbds_var, si}, - {"BDS-VAL", siLbds_val, si}, - {"SCH-FRS-BASE", siLsch_frs_base, si}, - {"RESET-STACK-LIMITS", siLreset_stack_limits, si}, - - /* string.d */ - - {"CHAR", clLchar, cl}, - {"CHAR-SET", siLchar_set, si}, - {"SCHAR", clLchar, cl}, - {"SCHAR-SET", siLchar_set, si}, - {"STRING=", clLstringE, cl}, - {"STRING-EQUAL", clLstring_equal, cl}, - {"STRING<", clLstringL, cl}, - {"STRING>", clLstringG, cl}, - {"STRING<=", clLstringLE, cl}, - {"STRING>=", clLstringGE, cl}, - {"STRING/=", clLstringNE, cl}, - {"STRING-LESSP", clLstring_lessp, cl}, - {"STRING-GREATERP", clLstring_greaterp, cl}, - {"STRING-NOT-LESSP", clLstring_not_lessp, cl}, - {"STRING-NOT-GREATERP", clLstring_not_greaterp, cl}, - {"STRING-NOT-EQUAL", clLstring_not_equal, cl}, - {"MAKE-STRING", clLmake_string, cl}, - {"STRING-TRIM", clLstring_trim, cl}, - {"STRING-LEFT-TRIM", clLstring_left_trim, cl}, - {"STRING-RIGHT-TRIM", clLstring_right_trim, cl}, - {"STRING-UPCASE", clLstring_upcase, cl}, - {"STRING-DOWNCASE", clLstring_downcase, cl}, - {"STRING-CAPITALIZE", clLstring_capitalize, cl}, - {"NSTRING-UPCASE", clLnstring_upcase, cl}, - {"NSTRING-DOWNCASE", clLnstring_downcase, cl}, - {"NSTRING-CAPITALIZE", clLnstring_capitalize, cl}, - {"STRING", clLstring, cl}, - {"STRING-CONCATENATE", siLstring_concatenate, si}, - - /* structure.c */ - - {"MAKE-STRUCTURE", siLmake_structure, si}, - {"COPY-STRUCTURE", siLcopy_structure, si}, - {"STRUCTURE-NAME", siLstructure_name, si}, - {"STRUCTURE-REF", siLstructure_ref, si}, - {"STRUCTURE-SET", siLstructure_set, si}, - {"STRUCTUREP", siLstructurep, si}, - {"STRUCTURE-SUBTYPE-P", siLstructure_subtype_p, si}, - {"RPLACA-NTHCDR", siLrplaca_nthcdr, si}, - {"LIST-NTH", siLlist_nth, si}, - - /* symbol.d */ - - {"GET", clLget, cl}, - {"REMPROP", clLremprop, cl}, - {"SYMBOL-PLIST", clLsymbol_plist, cl}, - {"GETF", clLgetf, cl}, - {"GET-PROPERTIES", clLget_properties, cl}, - {"SYMBOL-NAME", clLsymbol_name, cl}, - {"MAKE-SYMBOL", clLmake_symbol, cl}, - {"COPY-SYMBOL", clLcopy_symbol, cl}, - {"GENSYM", clLgensym, cl}, - {"GENTEMP", clLgentemp, cl}, - {"SYMBOL-PACKAGE", clLsymbol_package, cl}, - {"KEYWORDP", clLkeywordp, cl}, - {"PUT-F", siLput_f, si}, - {"REM-F", siLrem_f, si}, - {"SET-SYMBOL-PLIST", siLset_symbol_plist, si}, - {"PUTPROP", siLputprop, si}, - {"PUT-PROPERTIES", siLput_properties, si}, - - /* tcp.c */ -#ifdef TCP - {"OPEN-CLIENT-STREAM", siLopen_client_stream, si}, - {"OPEN-SERVER-STREAM", siLopen_server_stream, si}, -#endif - - /* time.c */ - - {"GET-UNIVERSAL-TIME", clLget_universal_time, cl}, - {"SLEEP", clLsleep, cl}, - {"GET-INTERNAL-RUN-TIME", clLget_internal_run_time, cl}, - {"GET-INTERNAL-REAL-TIME", clLget_internal_real_time, cl}, - {"GET-LOCAL-TIME-ZONE", siLget_local_time_zone, si}, - {"DAYLIGHT-SAVING-TIME-P", siLdaylight_saving_time_p, si}, - - /* toplevel.c */ - - {"LAMBDA", NULL, form}, - {"NAMED-LAMBDA", NULL, form}, - {"*MAKE-SPECIAL", siLXmake_special, si}, - {"*MAKE-CONSTANT", siLXmake_constant, si}, - {"EVAL-WHEN", NULL, form}, - {"THE", NULL, form}, - {"DECLARE", NULL, form}, - {"LOCALLY", NULL, form}, - - /* typespec.c */ - - {"TYPE-OF", clLtype_of, cl}, - - /* unixint.c */ - -#ifdef unix - {"CATCH-BAD-SIGNALS", siLcatch_bad_signals, si}, - {"UNCATCH-BAD-SIGNALS", siLuncatch_bad_signals, si}, -#endif /* unix */ - - /* unixfsys.c */ - - {"TRUENAME", clLtruename, cl}, - {"RENAME-FILE", clLrename_file, cl}, - {"DELETE-FILE", clLdelete_file, cl}, - {"PROBE-FILE", clLprobe_file, cl}, - {"FILE-WRITE-DATE", clLfile_write_date, cl}, - {"FILE-AUTHOR", clLfile_author, cl}, - {"USER-HOMEDIR-PATHNAME", clLuser_homedir_pathname, cl}, - {"STRING-MATCH", siLstring_match, si}, - {"DIRECTORY", clLdirectory, cl}, - {"CHDIR", siLchdir, si}, - {"MKDIR", siLmkdir, si}, - - /* unixsys.c */ - - {"SYSTEM", siLsystem, si}, - {"OPEN-PIPE", siLopen_pipe, si}, - - /* end of list */ - {NULL, NULL, 0} -}; - +#include "functions_list.h" void init_all_functions(void) { - const struct function_info *f = all_functions; + int i; - for (f = all_functions; f->name != NULL; f++) { - switch (f->type) { + for (i = 0; all_functions[i].name != NULL; i++) { + switch (all_functions[i].type) { case cl: - make_function(f->name, (cl_objectfn)f->f); + make_function(all_functions[i].name, (cl_objectfn)all_functions[i].f); break; case si: - make_si_function(f->name, (cl_objectfn)f->f); + make_si_function(all_functions[i].name+4, (cl_objectfn)all_functions[i].f); break; case form: { - cl_object s = make_ordinary(f->name); + cl_object s = make_ordinary(all_functions[i].name); s->symbol.isform = TRUE; s->symbol.mflag = FALSE; } diff --git a/src/c/all_symbols.d b/src/c/all_symbols.d index 40c05b58a..d0a76159a 100644 --- a/src/c/all_symbols.d +++ b/src/c/all_symbols.d @@ -1,320 +1,10 @@ #include #include "ecl.h" -#include "page.h" +#include "internal.h" -#define CL_ORDINARY 1 -#define CL_SPECIAL 2 -#define SI_SPECIAL 3 -#define SI_ORDINARY 4 +#include "symbols_list.h" -const struct symbol_info all_symbols[] = { -/* array.c */ -{&clSbyte8, "BYTE8", CL_ORDINARY}, -{&clSinteger8, "INTEGER8", CL_ORDINARY}, - -/* assignment.c */ -{&clSsetf, "SETF", CL_ORDINARY}, -{&clSpsetf, "PSETF", CL_ORDINARY}, -{&siSsetf_symbol, "SETF-SYMBOL", SI_ORDINARY}, -{&siSsetf_lambda, "SETF-LAMBDA", SI_ORDINARY}, -{&siSsetf_method, "SETF-METHOD", SI_ORDINARY}, -{&siSsetf_update, "SETF-UPDATE", SI_ORDINARY}, -{&siSclear_compiler_properties, "CLEAR-COMPILER-PROPERTIES", SI_ORDINARY}, -#ifdef PDE -{&siVrecord_source_pathname_p, "*RECORD-SOURCE-PATHNAME-P*", SI_SPECIAL}, -{&siSrecord_source_pathname, "RECORD-SOURCE-PATHNAME", SI_ORDINARY}, -#endif - -/* backq.c */ -{&siScomma, ",", SI_ORDINARY}, -{&siScomma_at, ",@@", SI_ORDINARY}, -{&siScomma_dot, ",.", SI_ORDINARY}, -{&clSlistX, "LIST*", CL_ORDINARY}, -{&clSappend, "APPEND", CL_ORDINARY}, -{&clSnconc, "NCONC", CL_ORDINARY}, - -/* bind.c */ -{&clSAoptional, "&OPTIONAL", CL_ORDINARY}, -{&clSArest, "&REST", CL_ORDINARY}, -{&clSAkey, "&KEY", CL_ORDINARY}, -{&clSAallow_other_keys, "&ALLOW-OTHER-KEYS", CL_ORDINARY}, -{&clSAaux, "&AUX", CL_ORDINARY}, - -/* block.c */ -{&clSblock, "BLOCK", CL_ORDINARY}, - -/* clos.c */ -#ifdef CLOS -{&siVclass_name_hash_table, "*CLASS-NAME-HASH-TABLE*", SI_SPECIAL}, -{&clSclass, "CLASS", CL_ORDINARY}, -{&clSbuilt_in_class, "BUILT-IN-CLASS", CL_ORDINARY}, -#endif - -/* compiler.c */ -{&clSlambda_block, "LAMBDA-BLOCK", CL_ORDINARY}, -{&siVkeep_definitions, "*KEEP-DEFINITIONS*", SI_SPECIAL}, - -/* conditional.c */ -{&clSotherwise, "OTHERWISE", CL_ORDINARY}, - -/* error.c */ -{&clSarithmetic_error, "ARITHMETIC-ERROR", CL_ORDINARY}, -{&clScell_error, "CELL-ERROR", CL_ORDINARY}, -{&clScondition, "CONDITION", CL_ORDINARY}, -{&clSdivision_by_zero, "DIVISION-BY-ZERO", CL_ORDINARY}, -{&clSend_of_file, "END-OF-FILE", CL_ORDINARY}, -{&clSerror, "ERROR", CL_ORDINARY}, -{&clSfile_error, "FILE-ERROR", CL_ORDINARY}, -{&clSfloating_point_inexact, "FLOATING-POINT-INEXACT", CL_ORDINARY}, -{&clSfloating_point_invalid_operation, "FLOATING-POINT-INVALID-OPERATION", CL_ORDINARY}, -{&clSfloating_point_overflow, "FLOATING-POINT-OVERFLOW", CL_ORDINARY}, -{&clSfloating_point_underflow, "FLOATING-POINT-UNDERFLOW", CL_ORDINARY}, -{&clSpackage_error, "PACKAGE-ERROR", CL_ORDINARY}, -{&clSparse_error, "PARSE-ERROR", CL_ORDINARY}, -{&clSprint_not_readable, "PRINT-NOT-READABLE", CL_ORDINARY}, -{&clSprogram_error, "PROGRAM-ERROR", CL_ORDINARY}, -{&clSreader_error, "READER-ERROR", CL_ORDINARY}, -{&clSserious_condition, "SERIOUS-CONDITION", CL_ORDINARY}, -{&clSsimple_condition, "SIMPLE-CONDITION", CL_ORDINARY}, -{&clSsimple_error, "SIMPLE-ERROR", CL_ORDINARY}, -{&clSsimple_type_error, "SIMPLE-TYPE-ERROR", CL_ORDINARY}, -{&clSsimple_warning, "SIMPLE-WARNING", CL_ORDINARY}, -{&clSstorage_condition, "STORAGE-CONDITION", CL_ORDINARY}, -{&clSstream_error, "STREAM-ERROR", CL_ORDINARY}, -{&clSstyle_warning, "STYLE-WARNING", CL_ORDINARY}, -{&clStype_error, "TYPE-ERROR", CL_ORDINARY}, -{&clSunbound_slot, "UNBOUND-SLOT", CL_ORDINARY}, -{&clSunbound_variable, "UNBOUND-VARIABLE", CL_ORDINARY}, -{&clSundefined_function, "UNDEFINED-FUNCTION", CL_ORDINARY}, -{&clSwarning, "WARNING", CL_ORDINARY}, - -{&siSsimple_program_error, "SIMPLE-PROGRAM-ERROR", SI_ORDINARY}, -{&siSsimple_control_error, "SIMPLE-CONTROL-ERROR", SI_ORDINARY}, - -{&siSuniversal_error_handler, "UNIVERSAL-ERROR-HANDLER", SI_ORDINARY}, -{&siSterminal_interrupt, "TERMINAL-INTERRUPT", SI_ORDINARY}, - -/* eval.c */ -{&clSapply, "APPLY", CL_ORDINARY}, -{&clSfuncall, "FUNCALL", CL_ORDINARY}, - -/* file.c */ -{&clVstandard_input, "*STANDARD-INPUT*", CL_SPECIAL}, -{&clVstandard_output, "*STANDARD-OUTPUT*", CL_SPECIAL}, -{&clVerror_output, "*ERROR-OUTPUT*", CL_SPECIAL}, -{&clVquery_io, "*QUERY-IO*", CL_SPECIAL}, -{&clVdebug_io, "*DEBUG-IO*", CL_SPECIAL}, -{&clVterminal_io, "*TERMINAL-IO*", CL_SPECIAL}, -{&clVtrace_output, "*TRACE-OUTPUT*", CL_SPECIAL}, -{&siVignore_eof_on_terminal_io, "*IGNORE-EOF-ON-TERMINAL-IO*", SI_SPECIAL}, -#ifdef ECL_CLOS_STREAMS -{&clSstream_input_p, "STREAM-INPUT-P", CL_ORDINARY}, -/*{&clSstream_read_line, "STREAM-READ-LINE", CL_ORDINARY},*/ -{&clSstream_read_char, "STREAM-READ-CHAR", CL_ORDINARY}, -{&clSstream_unread_char, "STREAM-UNREAD-CHAR", CL_ORDINARY}, -/*{&clSstream_peek_char, "STREAM-PEEK-CHAR", CL_ORDINARY},*/ -{&clSstream_listen, "STREAM-LISTEN", CL_ORDINARY}, -{&clSstream_clear_input, "STREAM-CLEAR-INPUT", CL_ORDINARY}, -{&clSstream_output_p, "STREAM-OUTPUT-P", CL_ORDINARY}, -{&clSstream_write_char, "STREAM-WRITE-CHAR", CL_ORDINARY}, -/*{&clSstream_write_string, "STREAM-WRITE-STRING", CL_ORDINARY},*/ -{&clSstream_clear_output, "STREAM-CLEAR-OUTPUT", CL_ORDINARY}, -{&clSstream_force_output, "STREAM-FORCE-OUTPUT", CL_ORDINARY}, -{&clSstream_close, "STREAM-CLOSE", CL_ORDINARY}, -#endif - -/* format.c */ -{&siVindent_formatted_output, "*INDENT-FORMATTED-OUTPUT*", SI_SPECIAL}, - -/* gbc.c */ -#if 0 && !defined(GBC_BOEHM) -{&siVgc_verbose, "*GC-VERBOSE*", SI_SPECIAL}, -{&siVgc_message, "*GC-MESSAGE*", SI_SPECIAL}, -#endif /* !GBC_BOEHM */ - -/* gfun.c */ -{&siScompute_applicable_methods, "COMPUTE-APPLICABLE-METHODS", SI_ORDINARY}, -{&siScompute_effective_method, "COMPUTE-EFFECTIVE-METHOD", SI_ORDINARY}, -{&siSgeneric_function_method_combination, "GENERIC-FUNCTION-METHOD-COMBINATION", SI_ORDINARY}, -{&siSgeneric_function_method_combination_args, "GENERIC-FUNCTION-METHOD-COMBINATION-ARGS", SI_ORDINARY}, - -/* hash.c */ -{&clSeq, "EQ", CL_ORDINARY}, -{&clSeql, "EQL", CL_ORDINARY}, -{&clSequal, "EQUAL", CL_ORDINARY}, - -/* instance.c */ -{&clSprint_object, "PRINT-OBJECT", CL_ORDINARY}, - -/* lex.c */ -{&clSmacro, "MACRO", CL_ORDINARY}, -{&siSsymbol_macro, "SYMBOL-MACRO", SI_ORDINARY}, -{&clStag, "TAG", CL_ORDINARY}, - -/* load.c */ -{&clVload_verbose, "*LOAD-VERBOSE*", CL_SPECIAL}, -{&clVload_print, "*LOAD-PRINT*", CL_SPECIAL}, -{&siVload_hooks, "*LOAD-HOOKS*", SI_SPECIAL}, -{&siVinit_function_prefix, "*INIT-FUNCTION-PREFIX*", SI_SPECIAL}, -#ifdef PDE -{&siVsource_pathname, "*SOURCE-PATHNAME*", CL_SPECIAL}, -#endif - -/* lwp.c */ -#ifdef THREADS -{&clSrunning, "RUNNING", CL_ORDINARY}, -{&clSsuspended, "SUSPENDED", CL_ORDINARY}, -{&clSwaiting, "WAITING", CL_ORDINARY}, -{&clSstopped, "STOPPED", CL_ORDINARY}, -{&clSdead, "DEAD", CL_ORDINARY}, -{&siSthread_top_level, "THREAD-TOP-LEVEL", SI_ORDINARY}, -#endif - -/* macros.c */ -{&clVmacroexpand_hook, "*MACROEXPAND-HOOK*", CL_SPECIAL}, -{&siSexpand_defmacro, "EXPAND-DEFMACRO", SI_ORDINARY}, -{&siVinhibit_macro_special, "*INHIBIT-MACRO-SPECIAL*", SI_SPECIAL}, - -/* main.c */ -{&clVfeatures, "*FEATURES*", CL_SPECIAL}, - -/* num_rand.c */ -{&clVrandom_state, "*RANDOM-STATE*", CL_SPECIAL}, - -/* package.c */ -{&clVpackage, "*PACKAGE*", CL_SPECIAL}, - -/* pathname.c */ -{&clVdefault_pathname_defaults, "*DEFAULT-PATHNAME-DEFAULTS*", CL_SPECIAL}, - -/* print.c */ -{&clVprint_escape, "*PRINT-ESCAPE*", CL_SPECIAL}, -{&clVprint_pretty, "*PRINT-PRETTY*", CL_SPECIAL}, -{&clVprint_circle, "*PRINT-CIRCLE*", CL_SPECIAL}, -{&clVprint_base, "*PRINT-BASE*", CL_SPECIAL}, -{&clVprint_radix, "*PRINT-RADIX*", CL_SPECIAL}, -{&clVprint_case, "*PRINT-CASE*", CL_SPECIAL}, -{&clVprint_gensym, "*PRINT-GENSYM*", CL_SPECIAL}, -{&clVprint_level, "*PRINT-LEVEL*", CL_SPECIAL}, -{&clVprint_length, "*PRINT-LENGTH*", CL_SPECIAL}, -{&clVprint_array, "*PRINT-ARRAY*", CL_SPECIAL}, -{&siSpretty_print_format, "PRETTY-PRINT-FORMAT", SI_ORDINARY}, -{&siSsharp_exclamation, "#!", SI_ORDINARY}, -{&siVprint_package, "*PRINT-PACKAGE*", SI_SPECIAL}, -{&siVprint_structure, "*PRINT-STRUCTURE*", SI_SPECIAL}, - -/* profile.c */ -#ifdef PROFILE -{&sSAprofile_arrayA, "*PROFILE-ARRAY*", SI_SPECIAL}, -#endif - -/* read.c */ -{&clVreadtable, "*READTABLE*", CL_SPECIAL}, -{&clVread_default_float_format, "*READ-DEFAULT-FLOAT-FORMAT*", CL_SPECIAL}, -{&clVread_base, "*READ-BASE*", CL_SPECIAL}, -{&clVread_suppress, "*READ-SUPPRESS*", CL_SPECIAL}, - -/* structure.c */ -{&siSstructure_print_function, "STRUCTURE-PRINT-FUNCTION", SI_ORDINARY}, -{&siSstructure_slot_descriptions, "STRUCTURE-SLOT-DESCRIPTIONS", SI_ORDINARY}, -#ifndef CLOS -{&siSstructure_include, "STRUCTURE-INCLUDE", SI_ORDINARY}, -#else -{&clSstructure_object, "STRUCTURE-OBJECT", CL_ORDINARY}, -#endif - -/* symbol.c */ -{&clVgensym_counter, "*GENSYM-COUNTER*", CL_SPECIAL}, - -/* toplevel.c */ -{&clSdeclare, "DECLARE", CL_ORDINARY}, -{&clScompile, "COMPILE", CL_ORDINARY}, -{&clSload, "LOAD", CL_ORDINARY}, -{&clSeval, "EVAL", CL_ORDINARY}, -{&clSprogn, "PROGN", CL_ORDINARY}, -{&clSwarn, "WARN", CL_ORDINARY}, -{&clStypep, "TYPEP", CL_ORDINARY}, - -/* typespec.c */ -{&clSquote, "QUOTE", CL_ORDINARY}, -{&clSlambda, "LAMBDA", CL_ORDINARY}, -{&clSspecial, "SPECIAL", CL_ORDINARY}, -{&clScommon, "COMMON", CL_ORDINARY}, -{&clSsequence, "SEQUENCE", CL_ORDINARY}, -{&clSnull, "NULL", CL_ORDINARY}, -{&clScons, "CONS", CL_ORDINARY}, -{&clSlist, "LIST", CL_ORDINARY}, -{&clSsymbol, "SYMBOL", CL_ORDINARY}, -{&clSarray, "ARRAY", CL_ORDINARY}, -{&clSvector, "VECTOR", CL_ORDINARY}, -{&clSbit_vector, "BIT-VECTOR", CL_ORDINARY}, -{&clSstring, "STRING", CL_ORDINARY}, -{&clSsimple_array, "SIMPLE-ARRAY", CL_ORDINARY}, -{&clSsimple_vector, "SIMPLE-VECTOR", CL_ORDINARY}, -{&clSsimple_string, "SIMPLE-STRING", CL_ORDINARY}, -{&clSsimple_bit_vector, "SIMPLE-BIT-VECTOR", CL_ORDINARY}, -{&clSfunction, "FUNCTION", CL_ORDINARY}, -{&clSpathname, "PATHNAME", CL_ORDINARY}, -{&clSlogical_pathname, "LOGICAL-PATHNAME", CL_ORDINARY}, -{&clScharacter, "CHARACTER", CL_ORDINARY}, -{&clSbase_char, "BASE-CHAR", CL_ORDINARY}, -{&clSextended_char, "EXTENDED-CHAR", CL_ORDINARY}, -{&clScompiled_function, "COMPILED-FUNCTION", CL_ORDINARY}, -{&clSnumber, "NUMBER", CL_ORDINARY}, -{&clSreal, "REAL", CL_ORDINARY}, -{&clSrational, "RATIONAL", CL_ORDINARY}, -{&clSfloat, "FLOAT", CL_ORDINARY}, -{&clSinteger, "INTEGER", CL_ORDINARY}, -{&clSratio, "RATIO", CL_ORDINARY}, -{&clSshort_float, "SHORT-FLOAT", CL_ORDINARY}, -{&clSstandard_char, "STANDARD-CHAR", CL_ORDINARY}, -{&clSfixnum, "FIXNUM", CL_ORDINARY}, -{&clScomplex, "COMPLEX", CL_ORDINARY}, -{&clSsingle_float, "SINGLE-FLOAT", CL_ORDINARY}, -{&clSpackage, "PACKAGE", CL_ORDINARY}, -{&clSbignum, "BIGNUM", CL_ORDINARY}, -{&clSrandom_state, "RANDOM-STATE", CL_ORDINARY}, -{&clSdouble_float, "DOUBLE-FLOAT", CL_ORDINARY}, -{&clSstream, "STREAM", CL_ORDINARY}, -{&clSfile_stream, "FILE-STREAM", CL_ORDINARY}, -{&clSstring_stream, "STRING-STREAM", CL_ORDINARY}, -{&clSsynonym_stream, "SYNONYM-STREAM", CL_ORDINARY}, -{&clStwo_way_stream, "TWO-WAY-STREAM", CL_ORDINARY}, -{&clSbroadcast_stream, "BROADCAST-STREAM", CL_ORDINARY}, -{&clSconcatenated_stream, "CONCATENATED-STREAM", CL_ORDINARY}, -{&clSecho_stream, "ECHO-STREAM", CL_ORDINARY}, -{&clSbit, "BIT", CL_ORDINARY}, -{&clSreadtable, "READTABLE", CL_ORDINARY}, -{&clSlong_float, "LONG-FLOAT", CL_ORDINARY}, -{&clShash_table, "HASH-TABLE", CL_ORDINARY}, -{&clSsigned_char, "SIGNED-CHAR", CL_ORDINARY}, -{&clSunsigned_char, "UNSIGNED-CHAR", CL_ORDINARY}, -{&clSsigned_short, "SIGNED-SHORT", CL_ORDINARY}, -{&clSunsigned_short, "UNSIGNED-SHORT", CL_ORDINARY}, -#ifdef CLOS -{&clSinstance, "INSTANCE", CL_ORDINARY}, -{&clSdispatch_function, "DISPATCH-FUNCTION", CL_ORDINARY}, -{&clSstructure, "STRUCTURE", CL_ORDINARY}, -#endif -{&clSsatisfies, "SATISFIES", CL_ORDINARY}, -{&clSmember, "MEMBER", CL_ORDINARY}, -{&clSnot, "NOT", CL_ORDINARY}, -{&clSor, "OR", CL_ORDINARY}, -{&clSand, "AND", CL_ORDINARY}, -{&clSvalues, "VALUES", CL_ORDINARY}, -{&clSmod, "MOD", CL_ORDINARY}, -{&clSsigned_byte, "SIGNED-BYTE", CL_ORDINARY}, -{&clSunsigned_byte, "UNSIGNED-BYTE", CL_ORDINARY}, -{&clV, "*", CL_ORDINARY}, -{&clSplusp, "PLUSP", CL_ORDINARY}, -{&clSkeyword, "KEYWORD", CL_ORDINARY}, -#ifdef THREADS -{&clScont, "CONT", CL_ORDINARY}, -{&clSthread, "THREAD", CL_ORDINARY}, -#endif -{&clSsubtypep, "SUBTYPEP", CL_ORDINARY}, - -{NULL, (const char*)NULL, CL_ORDINARY}}; +struct symbol cl_symbols[393]; @(defun si::mangle-name (symbol &optional as_symbol) int l; @@ -331,10 +21,13 @@ const struct symbol_info all_symbols[] = { @(return Ct make_simple_string("Cnil")) else if (symbol == Ct) @(return Ct make_simple_string("Ct")) - for (l = 0; all_symbols[l].loc != NULL; l++) { - if (symbol == *(all_symbols[l].loc)) { + for (l = 0; all_symbols[l].name != NULL; l++) { + if (symbol == (cl_object)(cl_symbols + l)) { found = Ct; - break; + output = @format(3, Cnil, + make_constant_string("((cl_object)(cl_symbols+~A))"), + MAKE_FIXNUM(l)); + @(return found output) } } } else { @@ -421,31 +114,52 @@ const struct symbol_info all_symbols[] = { @(return found output) @) -void -init_all_symbols(void) { - const struct symbol_info *s = all_symbols; - cl_object *loc; - - /* This must keep the garbage collector happy */ - for (s = all_symbols; s->name != NULL; s++) - *(s->loc) = OBJNULL; - - for (s = all_symbols; s->name != NULL; s++) { - loc = s->loc; - switch (s->type) { - case CL_ORDINARY: - *loc = make_ordinary(s->name); - break; - case CL_SPECIAL: - *loc = make_special(s->name, Cnil); - break; - case SI_ORDINARY: - *loc = make_si_ordinary(s->name); - break; - case SI_SPECIAL: - *loc = make_si_special(s->name, Cnil); - break; - } - /* register_root(loc);*/ - } +static void +make_this_symbol(int index, const char *name, cl_object package, bool special) +{ + cl_object s = (cl_object)(cl_symbols + index); + s->symbol.t = t_symbol; + SYM_VAL(s) = OBJNULL; + SYM_FUN(s) = OBJNULL; + s->symbol.plist = Cnil; + s->symbol.hpack = Cnil; + s->symbol.stype = special? stp_special : stp_ordinary; + s->symbol.mflag = FALSE; + s->symbol.isform = FALSE; + s->symbol.name = make_constant_string(name); + s->symbol.hpack = package; + cl_import(s, package); + sethash(s->symbol.name, package->pack.external, s); + if (package == keyword_package) { + s->symbol.stype = stp_constant; + SYM_VAL(s) = s; + } +} + +void +init_all_symbols(void) +{ + int i; + + /* We skip NIL and T */ + for (i = 2; all_symbols[i].name != NULL; i++) { + switch (all_symbols[i].type) { + case CL_ORDINARY: + make_this_symbol(i, all_symbols[i].name, lisp_package, FALSE); + break; + case CL_SPECIAL: + make_this_symbol(i, all_symbols[i].name, lisp_package, TRUE); + break; + case SI_ORDINARY: + make_this_symbol(i, all_symbols[i].name+4, system_package, FALSE); + break; + case SI_SPECIAL: + make_this_symbol(i, all_symbols[i].name+4, system_package, TRUE); + break; + case KEYWORD: + make_this_symbol(i, all_symbols[i].name+1, keyword_package, TRUE); + } + if (all_symbols[i].loc != NULL) + *(all_symbols[i].loc) = (cl_object)(cl_symbols+i); + } } diff --git a/src/c/alloc_2.d b/src/c/alloc_2.d index 5c433cfb6..6931a769b 100644 --- a/src/c/alloc_2.d +++ b/src/c/alloc_2.d @@ -270,9 +270,6 @@ valloc(size_t size) * GARBAGE COLLECTION * **********************************************************/ -cl_object @'si::*gc-verbose*'; -cl_object @'si::*gc-message*'; - void register_root(cl_object *p) { diff --git a/src/c/array.d b/src/c/array.d index 5b32cdb9d..7e516aa64 100644 --- a/src/c/array.d +++ b/src/c/array.d @@ -20,9 +20,6 @@ #define CHAR_BIT (sizeof(char)*8) #endif -cl_object @'byte8'; -cl_object @'integer8'; - static void displace (cl_object from, cl_object to, cl_object offset); static void check_displaced (cl_object dlist, cl_object orig, cl_index newdim); extern cl_elttype get_elttype (cl_object x); diff --git a/src/c/assignment.d b/src/c/assignment.d index 32fa0c6cb..9896bcbc6 100644 --- a/src/c/assignment.d +++ b/src/c/assignment.d @@ -17,18 +17,6 @@ #include "ecl.h" #include -cl_object @'setf'; -cl_object @'psetf'; -cl_object @'si::setf-symbol'; -cl_object @'si::setf-lambda'; -cl_object @'si::setf-method'; -cl_object @'si::setf-update'; -cl_object @'si::clear-compiler-properties'; -#ifdef PDE -cl_object @'si::*record-source-pathname-p*'; -cl_object @'si::record-source-pathname'; -#endif - cl_object set(cl_object var, cl_object val) { diff --git a/src/c/backq.d b/src/c/backq.d index a48ae51d9..f9c2926a1 100644 --- a/src/c/backq.d +++ b/src/c/backq.d @@ -32,14 +32,6 @@ int backq_level; #define APPEND 5 #define NCONC 6 -cl_object siScomma; -cl_object siScomma_at; -cl_object siScomma_dot; - -cl_object @'list*'; -cl_object @'append'; -cl_object @'nconc'; - static cl_object kwote(cl_object x) { @@ -71,11 +63,11 @@ backq_cdr(cl_object *px) if (ATOM(x)) return(QUOTE); - if (CAR(x) == siScomma) { + if (CAR(x) == @'si::,') { *px = CDR(x); return(EVAL); } - if (CAR(x) == siScomma_at || CAR(x) == siScomma_dot) + if (CAR(x) == @'si::,@' || CAR(x) == @'si::,.') FEerror(",@@ or ,. has appeared in an illegal position.", 0); { cl_object ax, dx; a = backq_car(&CAR(x)); @@ -202,15 +194,15 @@ backq_car(cl_object *px) if (ATOM(x)) return(QUOTE); - if (CAR(x) == siScomma) { + if (CAR(x) == @'si::,') { *px = CDR(x); return(EVAL); } - if (CAR(x) == siScomma_at) { + if (CAR(x) == @'si::,@') { *px = CDR(x); return(APPEND); } - if (CAR(x) == siScomma_dot) { + if (CAR(x) == @'si::,.') { *px = CDR(x); return(NCONC); } @@ -259,27 +251,29 @@ backq(cl_object x) return(x); } -@(defun comma_reader (in c) +static +@(defun "comma_reader" (in c) cl_object x, y; @ if (backq_level <= 0) FEerror("A comma has appeared out of a backquote.", 0); c = peek_char(FALSE, in); if (c == CODE_CHAR('@@')) { - x = siScomma_at; + x = @'si::,@'; read_char(in); } else if (c == CODE_CHAR('.')) { - x = siScomma_dot; + x = @'si::,.'; read_char(in); } else - x = siScomma; + x = @'si::,'; --backq_level; y = read_object(in); backq_level++; @(return CONS(x, y)) @) -@(defun backquote_reader (in c) +static +@(defun "backquote_reader" (in c) @ backq_level++; in = read_object(in); @@ -296,9 +290,9 @@ init_backq(void) r = standard_readtable; r->readtable.table['`'].syntax_type = cat_terminating; - r->readtable.table['`'].macro = make_cf((cl_objectfn)@backquote-reader); + r->readtable.table['`'].macro = make_cf((cl_objectfn)backquote_reader); r->readtable.table[','].syntax_type = cat_terminating; - r->readtable.table[','].macro = make_cf((cl_objectfn)@comma-reader); + r->readtable.table[','].macro = make_cf((cl_objectfn)comma_reader); backq_level = 0; } diff --git a/src/c/cfun.d b/src/c/cfun.d index e3a3ec77c..e14401a3e 100644 --- a/src/c/cfun.d +++ b/src/c/cfun.d @@ -17,10 +17,6 @@ #include "ecl.h" #include /* for memmove() */ -#ifdef PDE -cl_object @'defun', @'defmacro'; -#endif - cl_object make_cfun(cl_objectfn self, cl_object name, cl_object cblock) { @@ -55,9 +51,6 @@ MF(cl_object sym, cl_objectfn self, cl_object block) if (sym->symbol.isform && sym->symbol.mflag) sym->symbol.isform = FALSE; clear_compiler_properties(sym); -#ifdef PDE - record_source_pathname(sym, @'defun'); -#endif cf = cl_alloc_object(t_cfun); cf->cfun.entry = self; cf->cfun.name = sym; diff --git a/src/c/clos.d b/src/c/clos.d index a8024ee1f..98c41288d 100644 --- a/src/c/clos.d +++ b/src/c/clos.d @@ -18,9 +18,6 @@ /******************************* EXPORTS ******************************/ cl_object class_class, class_object, class_built_in; -cl_object @'si::*class-name-hash-table*'; -cl_object @'class'; -cl_object @'built-in-class'; /******************************* ------- ******************************/ diff --git a/src/c/compiler.d b/src/c/compiler.d index 10fd8c800..3105d61f9 100644 --- a/src/c/compiler.d +++ b/src/c/compiler.d @@ -21,31 +21,6 @@ #define REGISTER_SPECIALS 1 #define IGNORE_DECLARATIONS 0 -cl_object @'lambda-block'; -cl_object @'declare'; -cl_object @'defun'; -cl_object @'compile', @'load', @'eval', @'progn', @'warn', @'typep', @'otherwise'; -cl_object @':execute', @':compile-toplevel', @':load-toplevel'; -cl_object @'si::*inhibit-macro-special*'; -cl_object @'si::*keep-definitions*'; - -cl_object @'&optional'; -cl_object @'&rest'; -cl_object @'&key'; -cl_object @'&allow-other-keys'; -cl_object @'&aux'; - -cl_object @'si::symbol-macro'; -cl_object @'tag'; -cl_object @'block'; -cl_object @'macro'; -cl_object @'function'; -cl_object @':block'; -cl_object @':tag'; -cl_object @':function'; - -cl_object @':allow-other-keys'; - typedef struct { cl_object variables; cl_object macros; @@ -999,7 +974,7 @@ c_dolist_dotimes(int op, cl_object args) { /* Output */ asm_complete(OP_EXIT, labelo); - if (CDR(head) != Cnil) + if (head != Cnil && CDR(head) != Cnil) FEprogram_error("DOLIST: Too many output forms.", 0); if (Null(head)) compile_body(Cnil); diff --git a/src/c/dpp.c b/src/c/dpp.c index 33b62bd9b..79826a629 100644 --- a/src/c/dpp.c +++ b/src/c/dpp.c @@ -71,6 +71,11 @@ #include #include +#define DPP +#include "config.h" +#include "functions_list.h" +#include "symbols_list.h" + #define POOLSIZE 2048 #define MAXREQ 16 #define MAXOPT 16 @@ -200,117 +205,103 @@ pushc(int c) *poolp++ = c; } -char * -read_name(int is_symbol) +pushstr(const char *s) { - int c, l; - int oneX = 0, oneC = 0; - char *colon = NULL; - char *p; + while (*s) + pushc(*(s++)); +} + +int +search_keyword(const char *name) +{ + int i; + char c[256]; + + for (i=0; name[i] && i<255; i++) + if (name[i] == '_') + c[i] = '-'; + else + c[i] = name[i]; + if (i == 255) + error("Too long keyword"); + c[i] = 0; + for (i = 0; all_symbols[i].name != NULL; i++) { + if (all_symbols[i].name[0] == ':') + if (!strcasecmp(c, all_symbols[i].name+1)) + return i; + } + printf("Keyword not found: %s.\n", c); + return 0; +} + +char * +read_symbol() +{ + char c, *name = poolp; + int i; c = readc(); - while (isspace(c)) { - pushc(c); + while (c != '\'') { + if (c == '_') c = '-'; + pushc(c); c = readc(); } - p = poolp; - do { - if (isalpha(c)) - ; /* c=tolower(c) */ - else if (isdigit(c)) - ; - else if (c == '-' || c == '_') - c = '_'; - else if (c == '&') - c = 'A'; - else if (c == '*') { - if (is_symbol && !oneX && (poolp == colon || poolp == p)) - { - if (poolp > p && poolp[-1] == 'S') - poolp--; - oneX = 1; - c = 'V'; - } else { - c = 'X'; - } - } else if (c == '+') { - if (is_symbol && !oneC && (poolp == colon || poolp == p)) - { - if (poolp > p && poolp[-1] == 'S') - poolp--; - oneC = 1; - c = 'C'; - } else { - c = 'P'; - } - } else if (c == '<') { - c = 'L'; - } else if (c == '>') { - c = 'G'; - } else if (c == '=') { - c = 'E'; - } else if (c == '/') { - c = 'N'; - } else if (c == ':') { - if (colon == poolp) { - c = readc(); - continue; - } else if (colon != NULL) - error("double colon ':' in symbol name"); - else { - colon = poolp+1; - if (poolp == p) - c = 'K'; /* Keyword */ - else if (!is_symbol) - c = 'L'; /* Function name */ - else if (oneX == NULL) - c = 'S'; /* Symbol name */ - else { - c = readc(); - continue; - } - } - } else if (!is_symbol) { - unreadc(c); - break; - } else if (c == '\'') { - break; - } else { - error("Disallowed character in symbol name"); + pushc(0); + + for (i = 0; all_symbols[i].name != NULL; i++) { + if (!strcasecmp(name, all_symbols[i].name)) { + poolp = name; + pushstr("(cl_object)(cl_symbols+"); + if (i >= 100) + pushc((i / 100) % 10 + '0'); + if (i >= 10) + pushc((i / 10) % 10 + '0'); + pushc(i % 10 + '0'); + pushstr(")"); + return name; } - pushc(c); - c = readc(); - } while (1); - l = poolp - p; - if (l > 2 && oneX && poolp[-1] == 'X') - poolp--; - if (l > 2 && oneC && poolp[-1] == 'P') - poolp--; - if (poolp[-1] == '_') - poolp[-1] = 'M'; - if (colon == NULL) { - char buf[256]; - poolp[0] = buf[0] = '\0'; - strcpy(buf, "cl"); - if (!oneX && p[0] != 'K') - strcat(buf, is_symbol? "S" : "L"); - strcat(buf, p); - strcpy(p, buf); - poolp = p + strlen(buf); } - return p; + printf("\nUnknown symbol: %s\n", name); + poolp = name; + pushstr("unknown"); + return name; } char * -read_symbol_name(void) +read_function() { - return read_name(1); -} + char c, *name = poolp; + int i; -char * -read_func_name(void) -{ - return read_name(0); + c = readc(); + if (c == '"') { + c = readc(); + while (c != '"') { + pushc(c); + c = readc(); + } + pushc(0); + return name; + } + while (c != '(' && !isspace(c) && c != ')') { + if (c == '_') c = '-'; + pushc(c); + c = readc(); + } + unreadc(c); + pushc(0); + + for (i = 0; all_functions[i].name != NULL; i++) { + if (!strcasecmp(name, all_functions[i].name)) { + poolp = name; + pushstr(all_functions[i].translation); + return name; + } + } + printf("\nUnknown function: %s\n", name); + poolp = name; + pushstr("unknown"); + return name; } char * @@ -343,12 +334,12 @@ read_token(void) } else if (c == '@') { c = readc(); if (c == '\'') { - (void)read_symbol_name(); + (void)read_symbol(); } else if (c == '@') { pushc(c); } else { unreadc(c); - (void)read_func_name(); + (void)read_function(); } } else { pushc(c); @@ -395,7 +386,7 @@ reset(void) get_function(void) { - function = read_func_name(); + function = read_function(); pushc('\0'); } @@ -452,7 +443,7 @@ OPTIONAL: REST: if (strcmp(p, "rest") != 0 && strcmp(p, "r") != 0) - goto KEYWORD; + goto KEY; rest_flag = TRUE; if ((c = nextc()) == ')' || c == '&') error("&rest var missing"); @@ -463,9 +454,9 @@ REST: if (c != '&') error("& expected"); p = read_token(); - goto KEYWORD; + goto KEY; -KEYWORD: +KEY: if (strcmp(p, "key") != 0 && strcmp(p, "k") != 0) goto AUX; key_flag = TRUE; @@ -587,7 +578,13 @@ put_declaration(void) } if (nkey > 0) { put_lineno(); - fprintf(out, "\tcl_object KEYS[%d];\n", nkey); + fprintf(out, "\tstatic cl_object KEYS[%d] = {", nkey); + for (i = 0; i < nkey; i++) { + if (i > 0) + fprintf(out, ", "); + fprintf(out, "(cl_object)(cl_symbols+%d)", search_keyword(keyword[i].k_key)); + } + fprintf(out, "};\n"); } for (i = 0; i < nkey; i++) { fprintf(out, "\tcl_object %s;\n", keyword[i].k_var); @@ -639,10 +636,6 @@ put_declaration(void) fprintf(out, "\t}\n"); } if (key_flag) { - for (i = 0; i < nkey; i++) { - put_lineno(); - fprintf(out, "\tKEYS[%d]=K%s;\n", i, keyword[i].k_key); - } put_lineno(); fprintf(out, "\tva_parse_key(narg-%d, ARGS, %d, KEYS, KEY_VARS, NULL, %d);\n", nreq+nopt, nkey, allow_other_keys_flag); @@ -739,7 +732,7 @@ LOOP: } else if (c == '\'') { char *p; poolp = pool; - p = read_symbol_name(); + p = read_symbol(); pushc('\0'); fprintf(out,"%s",p); goto LOOP; @@ -747,7 +740,7 @@ LOOP: char *p; unreadc(c); poolp = pool; - p = read_func_name(); + p = read_function(); pushc('\0'); fprintf(out,"%s",p); goto LOOP; diff --git a/src/c/error.d b/src/c/error.d index 087608881..eb95e62a9 100644 --- a/src/c/error.d +++ b/src/c/error.d @@ -17,27 +17,6 @@ #include "ecl.h" -/******************************* EXPORTS ******************************/ - -cl_object @'arithmetic-error', @'cell-error', @'condition'; -cl_object @'control-error', @'division-by-zero', @'end-of-file'; -cl_object @'error', @'file-error', @'floating-point-inexact'; -cl_object @'floating-point-invalid-operation', @'floating-point-overflow'; -cl_object @'floating-point-underflow', @'package-error', @'parse-error'; -cl_object @'print-not-readable', @'program-error', @'reader-error'; -cl_object @'serious-condition', @'simple-condition', @'simple-error'; -cl_object @'simple-type-error', @'simple-warning', @'storage-condition'; -cl_object @'stream-error', @'style-warning', @'type-error', @'unbound-slot'; -cl_object @'unbound-variable', @'undefined-function', @'warning'; - -cl_object @'si::simple-program-error', @'si::simple-control-error'; - -cl_object @':pathname'; /* file-error */ -cl_object @':datum', @':expected-type'; /* type-error */ -cl_object @':format-control', @':format-arguments'; /* simple-condition */ - -/******************************* ------- ******************************/ - void cs_overflow(void) { @@ -77,12 +56,8 @@ internal_error(const char *s) /* Support for Lisp Error Handler */ /*****************************************************************************/ -cl_object @'si::universal-error-handler'; - cl_object null_string; -cl_object @'si::terminal-interrupt'; - void terminal_interrupt(bool correctable) { @@ -232,7 +207,7 @@ FEinvalid_function(cl_object obj) /* bootstrap version */ static -@(defun si::universal_error_handler (c err args) +@(defun "universal_error_handler" (c err args) @ printf("\nLisp initialization error.\n"); @print(1, err); diff --git a/src/c/eval.d b/src/c/eval.d index 765432792..17f495252 100644 --- a/src/c/eval.d +++ b/src/c/eval.d @@ -18,13 +18,6 @@ #include "ecl.h" #include "ecl-inl.h" -/******************************* EXPORTS ******************************/ - -cl_object @'apply'; -cl_object @'funcall'; - -/******************************* ------- ******************************/ - static struct nil3 { cl_object nil3_self[3]; } three_nils; #define SYMBOL_FUNCTION(sym) (SYM_FUN(sym) == OBJNULL ? \ @@ -84,9 +77,6 @@ apply(int narg, cl_object fun, cl_object *args) * Linking mechanism * *----------------------------------------------------------------------*/ -static cl_object @'si::link-to'; -static cl_object @'si::link-from'; - cl_object #ifdef CLOS link_call(cl_object sym, cl_objectfn *pLK, cl_object *gfun, @@ -223,9 +213,4 @@ init_eval(void) three_nils.nil3_self[0] = Cnil; three_nils.nil3_self[1] = Cnil; three_nils.nil3_self[2] = Cnil; - - @'si::link-from' = make_si_ordinary("LINK-FROM"); - register_root(&@'si::link-from'); - @'si::link-to' = make_si_ordinary("LINK-TO"); - register_root(&@'si::link-to'); } diff --git a/src/c/file.d b/src/c/file.d index c809bd19d..5eb832e0a 100644 --- a/src/c/file.d +++ b/src/c/file.d @@ -27,58 +27,8 @@ #include #endif -/******************************* EXPORTS ******************************/ -cl_object @'*standard-input*'; -cl_object @'*standard-output*'; -cl_object @'*error-output*'; -cl_object @'*query-io*'; -cl_object @'*debug-io*'; -cl_object @'*terminal-io*'; -cl_object @'*trace-output*'; - -cl_object @':abort'; -cl_object @':direction'; -cl_object @':input'; -cl_object @':output'; -cl_object @':io'; -cl_object @':probe'; -cl_object @':element_type'; -cl_object @':default'; -cl_object @':if_exists'; -cl_object @':error'; -cl_object @':new_version'; -cl_object @':rename'; -cl_object @':rename_and_delete'; -cl_object @':overwrite'; -cl_object @':append'; -cl_object @':supersede'; -cl_object @':create'; -cl_object @':print'; -cl_object @':if_does_not_exist'; -cl_object @':set_default_pathname'; - -#ifdef ECL_CLOS_STREAMS -cl_object @'stream-input-p'; -/*cl_object @'stream-read-line';*/ -cl_object @'stream-read-char'; -cl_object @'stream-unread-char'; -/*cl_object @'stream-peek-char';*/ -cl_object @'stream-listen'; -cl_object @'stream-clear-input'; -cl_object @'stream-output-p'; -cl_object @'stream-write-char'; -/*cl_object @'stream-write-string';*/ -cl_object @'stream-clear-output'; -cl_object @'stream-force-output'; -cl_object @'stream-close'; -#endif /* ECL_CLOS_STREAMS */ - -/******************************* ------- ******************************/ - static cl_object terminal_io; -cl_object @'si::*ignore-eof-on-terminal-io*'; - static bool feof1(FILE *fp) { diff --git a/src/c/format.d b/src/c/format.d index bc4a93485..194078e96 100644 --- a/src/c/format.d +++ b/src/c/format.d @@ -18,8 +18,6 @@ #include #include "internal.h" -cl_object @'si::*indent-formatted-output*'; - #define FMT_MAX_PARAM 8 typedef struct format_stack_struct { cl_object stream; @@ -1686,7 +1684,7 @@ fmt_justification(format_stack fmt, volatile bool colon, bool atsign) l += cl_stack[i]->string.fillp; /* * Count the number of segments that need padding, "M". If the colon - * modifier, the first item needs padding. If the @ modifier is + * modifier, the first item needs padding. If the @@ modifier is * present, the last modifier also needs padding. */ m = fields_end - fields_start - 1; diff --git a/src/c/functions_list.h b/src/c/functions_list.h new file mode 100644 index 000000000..3241aa935 --- /dev/null +++ b/src/c/functions_list.h @@ -0,0 +1,853 @@ +#define form 2 +#define cl 0 +#define si 1 + +#ifdef DPP +#define SW(a,b,c) a +#else +#define SW(a,b,c) b, c +#endif + +const struct { + const char *name; +#ifdef DPP + const char *translation; +#else + cl_object (*f)(int, ...); + short type; +#endif +} all_functions[] = { + + /* alloc.c */ + +#if !defined(GBC_BOEHM) + {"SI::ALLOCATE", SW("siLallocate",siLallocate,si)}, + {"SI::ALLOCATED-PAGES", SW("siLallocated_pages",siLallocated_pages,si)}, + {"SI::MAXIMUM-ALLOCATABLE-PAGES", SW("siLmaxpage",siLmaxpage,si)}, + {"SI::ALLOCATE-CONTIGUOUS-PAGES", SW("siLalloc_contpage",siLalloc_contpage,si)}, + {"SI::ALLOCATED-CONTIGUOUS-PAGES", SW("siLncbpage",siLncbpage,si)}, + {"SI::MAXIMUM-CONTIGUOUS-PAGES", SW("siLmaxcbpage",siLmaxcbpage,si)}, + {"SI::GET-HOLE-SIZE", SW("siLget_hole_size",siLget_hole_size,si)}, + {"SI::SET-HOLE-SIZE", SW("siLset_hole_size",siLset_hole_size,si)}, + {"SI::IGNORE-MAXIMUM-PAGES", SW("siLignore_maximum_pages",siLignore_maximum_pages,si)}, +#endif /* !GBC_BOEHM */ + + /* alloc_2.c */ + +#ifdef GBC_BOEHM + {"GC", SW("clLgc",clLgc,cl)}, +#endif + + /* all_symbols.c */ + + {"SI::MANGLE-NAME", SW("siLmangle_name",siLmangle_name,si)}, + + /* array.c */ + + {"SI::MAKE-PURE-ARRAY", SW("siLmake_pure_array",siLmake_pure_array,si)}, + {"SI::MAKE-VECTOR", SW("siLmake_vector",siLmake_vector,si)}, + {"AREF", SW("clLaref",clLaref,cl)}, + {"SI::ASET", SW("siLaset",siLaset,si)}, + {"ARRAY-ELEMENT-TYPE", SW("clLarray_element_type",clLarray_element_type,cl)}, + {"ARRAY-RANK", SW("clLarray_rank",clLarray_rank,cl)}, + {"ARRAY-DIMENSION", SW("clLarray_dimension",clLarray_dimension,cl)}, + {"ARRAY-TOTAL-SIZE", SW("clLarray_total_size",clLarray_total_size,cl)}, + {"ADJUSTABLE-ARRAY-P", SW("clLadjustable_array_p",clLadjustable_array_p,cl)}, + {"SI::DISPLACED-ARRAY-P", SW("siLdisplaced_array_p",siLdisplaced_array_p,si)}, + {"ROW-MAJOR-AREF", SW("clLrow_major_aref",clLrow_major_aref,cl)}, + {"SI::ROW-MAJOR-ASET", SW("siLrow_major_aset",siLrow_major_aset,si)}, + + {"SVREF", SW("clLsvref",clLsvref,cl)}, + {"SI::SVSET", SW("siLsvset",siLsvset,si)}, + + {"ARRAY-HAS-FILL-POINTER-P", SW("clLarray_has_fill_pointer_p",clLarray_has_fill_pointer_p,cl)}, + {"FILL-POINTER", SW("clLfill_pointer",clLfill_pointer,cl)}, + {"SI::FILL-POINTER-SET", SW("siLfill_pointer_set",siLfill_pointer_set,si)}, + + {"SI::REPLACE-ARRAY", SW("siLreplace_array",siLreplace_array,si)}, + + /* assignment.c */ + + {"SI::CLEAR-COMPILER-PROPERTIES", SW("siLclear_compiler_properties",siLclear_compiler_properties,si)}, + {"SETQ", SW("NULL",NULL,form)}, + {"PSETQ", SW("NULL",NULL,form)}, + {"SET", SW("clLset",clLset,cl)}, + {"SI::FSET", SW("siLfset",siLfset,si)}, + {"MULTIPLE-VALUE-SETQ", SW("NULL",NULL,form)}, + {"MAKUNBOUND", SW("clLmakunbound",clLmakunbound,cl)}, + {"FMAKUNBOUND", SW("clLfmakunbound",clLfmakunbound,cl)}, +#if 0 + {"SETF", SW("NULL",NULL,form)}, + {"PUSH", SW("NULL",NULL,form)}, + {"POP", SW("NULL",NULL,form)}, + {"INCF", SW("NULL",NULL,form)}, + {"DECF", SW("NULL",NULL,form)}, +#endif + {"SI::SETF-NAMEP", SW("siLsetf_namep",siLsetf_namep,si)}, + + /* block.c */ + + {"BLOCK", SW("NULL",NULL,form)}, + {"RETURN-FROM", SW("NULL",NULL,form)}, + {"RETURN", SW("NULL",NULL,form)}, + + /* catch.c */ + + {"CATCH", SW("NULL",NULL,form)}, + {"UNWIND-PROTECT", SW("NULL",NULL,form)}, + {"THROW", SW("NULL",NULL,form)}, + + /* cfun.c */ + + {"SI::COMPILED-FUNCTION-NAME", SW("siLcompiled_function_name",siLcompiled_function_name,si)}, + {"SI::COMPILED-FUNCTION-BLOCK", SW("siLcompiled_function_block",siLcompiled_function_block,si)}, + {"SI::COMPILED-FUNCTION-SOURCE", SW("siLcompiled_function_source",siLcompiled_function_source,si)}, + + /* character.d */ + + {"STANDARD-CHAR-P", SW("clLstandard_char_p",clLstandard_char_p,cl)}, + {"GRAPHIC-CHAR-P", SW("clLgraphic_char_p",clLgraphic_char_p,cl)}, + {"ALPHA-CHAR-P", SW("clLalpha_char_p",clLalpha_char_p,cl)}, + {"UPPER-CASE-P", SW("clLupper_case_p",clLupper_case_p,cl)}, + {"LOWER-CASE-P", SW("clLlower_case_p",clLlower_case_p,cl)}, + {"BOTH-CASE-P", SW("clLboth_case_p",clLboth_case_p,cl)}, + {"DIGIT-CHAR-P", SW("clLdigit_char_p",clLdigit_char_p,cl)}, + {"ALPHANUMERICP", SW("clLalphanumericp",clLalphanumericp,cl)}, + {"CHAR=", SW("clLcharE",clLcharE,cl)}, + {"CHAR/=", SW("clLcharNE",clLcharNE,cl)}, + {"CHAR<", SW("clLcharL",clLcharL,cl)}, + {"CHAR>", SW("clLcharG",clLcharG,cl)}, + {"CHAR<=", SW("clLcharLE",clLcharLE,cl)}, + {"CHAR>=", SW("clLcharGE",clLcharGE,cl)}, + {"CHAR-EQUAL", SW("clLchar_equal",clLchar_equal,cl)}, + {"CHAR-NOT-EQUAL", SW("clLchar_not_equal",clLchar_not_equal,cl)}, + {"CHAR-LESSP", SW("clLchar_lessp",clLchar_lessp,cl)}, + {"CHAR-GREATERP", SW("clLchar_greaterp",clLchar_greaterp,cl)}, + {"CHAR-NOT-GREATERP", SW("clLchar_not_greaterp",clLchar_not_greaterp,cl)}, + {"CHAR-NOT-LESSP", SW("clLchar_not_lessp",clLchar_not_lessp,cl)}, + {"CHARACTER", SW("clLcharacter",clLcharacter,cl)}, + {"CHAR-CODE", SW("clLchar_code",clLchar_code,cl)}, + {"CODE-CHAR", SW("clLcode_char",clLcode_char,cl)}, + {"CHAR-UPCASE", SW("clLchar_upcase",clLchar_upcase,cl)}, + {"CHAR-DOWNCASE", SW("clLchar_downcase",clLchar_downcase,cl)}, + {"DIGIT-CHAR", SW("clLdigit_char",clLdigit_char,cl)}, + {"CHAR-INT", SW("clLchar_int",clLchar_int,cl)}, + {"INT-CHAR", SW("clLint_char",clLint_char,cl)}, + {"CHAR-NAME", SW("clLchar_name",clLchar_name,cl)}, + {"NAME-CHAR", SW("clLname_char",clLname_char,cl)}, + + /* clos.c */ + {"FIND-CLASS", SW("clLfind_class",clLfind_class,cl)}, + + /* cmpaux.c */ + + {"SI::SPECIALP", SW("siLspecialp",siLspecialp,si)}, + + /* conditional.c */ + + {"IF", SW("NULL",NULL,form)}, + {"COND", SW("NULL",NULL,form)}, + {"CASE", SW("NULL",NULL,form)}, + {"WHEN", SW("NULL",NULL,form)}, + {"UNLESS", SW("NULL",NULL,form)}, + + /* disassembler.c */ + {"SI::BC-DISASSEMBLE", SW("siLbc_disassemble",siLbc_disassemble,si)}, + {"SI::BC-SPLIT", SW("siLbc_split",siLbc_split,si)}, + + /* error.c */ + + {"ERROR", SW("clLerror",clLerror,cl)}, + {"CERROR", SW("clLcerror",clLcerror,cl)}, + + /* eval.c */ + + {"EVAL", SW("clLeval",clLeval,cl)}, + {"SI::EVAL-WITH-ENV", SW("siLeval_with_env",siLeval_with_env,si)}, + {"CONSTANTP", SW("clLconstantp",clLconstantp,cl)}, + {"SI::UNLINK-SYMBOL", SW("siLunlink_symbol",siLunlink_symbol,si)}, + {"APPLY", SW("clLapply",clLapply,cl)}, + {"FUNCALL", SW("clLfuncall",clLfuncall,cl)}, + + /* file.d */ + + {"MAKE-SYNONYM-STREAM", SW("clLmake_synonym_stream",clLmake_synonym_stream,cl)}, + {"MAKE-BROADCAST-STREAM", SW("clLmake_broadcast_stream",clLmake_broadcast_stream,cl)}, + {"MAKE-CONCATENATED-STREAM", SW("clLmake_concatenated_stream",clLmake_concatenated_stream,cl)}, + {"MAKE-TWO-WAY-STREAM", SW("clLmake_two_way_stream",clLmake_two_way_stream,cl)}, + {"MAKE-ECHO-STREAM", SW("clLmake_echo_stream",clLmake_echo_stream,cl)}, + {"MAKE-STRING-INPUT-STREAM", SW("clLmake_string_input_stream",clLmake_string_input_stream,cl)}, + {"MAKE-STRING-OUTPUT-STREAM", SW("clLmake_string_output_stream",clLmake_string_output_stream,cl)}, + {"GET-OUTPUT-STREAM-STRING", SW("clLget_output_stream_string",clLget_output_stream_string,cl)}, + + {"SI::OUTPUT-STREAM-STRING", SW("siLoutput_stream_string",siLoutput_stream_string,si)}, + + {"STREAMP", SW("clLstreamp",clLstreamp,cl)}, + {"INPUT-STREAM-P", SW("clLinput_stream_p",clLinput_stream_p,cl)}, + {"OUTPUT-STREAM-P", SW("clLoutput_stream_p",clLoutput_stream_p,cl)}, + {"STREAM-ELEMENT-TYPE", SW("clLstream_element_type",clLstream_element_type,cl)}, + {"CLOSE", SW("clLclose",clLclose,cl)}, + {"OPEN", SW("clLopen",clLopen,cl)}, + {"FILE-POSITION", SW("clLfile_position",clLfile_position,cl)}, + {"FILE-LENGTH", SW("clLfile_length",clLfile_length,cl)}, + {"OPEN-STREAM-P", SW("clLopen_stream_p",clLopen_stream_p,cl)}, + {"SI::GET-STRING-INPUT-STREAM-INDEX", SW("siLget_string_input_stream_index",siLget_string_input_stream_index,si)}, + {"SI::MAKE-STRING-OUTPUT-STREAM-FROM-STRING", SW("siLmake_string_output_stream_from_string",siLmake_string_output_stream_from_string,si)}, + {"SI::COPY-STREAM", SW("siLcopy_stream",siLcopy_stream,si)}, + + /* format. c */ + + {"FORMAT", SW("clLformat",clLformat,cl)}, + + /* gbc.c */ + +#if !defined(GBC_BOEHM) + {"SI::ROOM-REPORT", SW("siLroom_report",siLroom_report,si)}, + {"SI::RESET-GC-COUNT", SW("siLreset_gc_count",siLreset_gc_count,si)}, + {"GC", SW("clLgc",clLgc,cl)}, + {"SI::GC-TIME", SW("siLgc_time",siLgc_time,si)}, +#endif + + /* gfun.c */ +#ifdef CLOS + {"SI::ALLOCATE-GFUN", SW("siLallocate_gfun",siLallocate_gfun,si)}, + {"SI::GFUN-NAME", SW("siLgfun_name",siLgfun_name,si)}, + {"SI::GFUN-NAME-SET", SW("siLgfun_name_set",siLgfun_name_set,si)}, + {"SI::GFUN-METHOD-HT", SW("siLgfun_method_ht",siLgfun_method_ht,si)}, + {"SI::GFUN-METHOD-HT-SET", SW("siLgfun_method_ht_set",siLgfun_method_ht_set,si)}, + {"SI::GFUN-SPEC-HOW-REF", SW("siLgfun_spec_how_ref",siLgfun_spec_how_ref,si)}, + {"SI::GFUN-SPEC-HOW-SET", SW("siLgfun_spec_how_set",siLgfun_spec_how_set,si)}, + {"SI::GFUN-INSTANCE", SW("siLgfun_instance",siLgfun_instance,si)}, + {"SI::GFUN-INSTANCE-SET", SW("siLgfun_instance_set",siLgfun_instance_set,si)}, + {"SI::GFUNP", SW("siLgfunp",siLgfunp,si)}, + {"SI::METHOD-HT-GET", SW("siLmethod_ht_get",siLmethod_ht_get,si)}, + {"SI::SET-COMPILED-FUNCTION-NAME", SW("siLset_compiled_function_name",siLset_compiled_function_name,si)}, +#endif /* CLOS */ + + /* hash.d */ + + {"MAKE-HASH-TABLE", SW("clLmake_hash_table",clLmake_hash_table,cl)}, + {"HASH-TABLE-P", SW("clLhash_table_p",clLhash_table_p,cl)}, + {"GETHASH", SW("clLgethash",clLgethash,cl)}, + {"REMHASH", SW("clLremhash",clLremhash,cl)}, + {"MAPHASH", SW("clLmaphash",clLmaphash,cl)}, + {"CLRHASH", SW("clLclrhash",clLclrhash,cl)}, + {"HASH-TABLE-COUNT", SW("clLhash_table_count",clLhash_table_count,cl)}, + {"SXHASH", SW("clLsxhash",clLsxhash,cl)}, + {"SI::HASH-SET", SW("siLhash_set",siLhash_set,si)}, + {"HASH-TABLE-REHASH-SIZE", SW("clLhash_table_rehash_size",clLhash_table_rehash_size,cl)}, + {"HASH-TABLE-REHASH-THRESHOLD", SW("clLhash_table_rehash_threshold",clLhash_table_rehash_threshold,cl)}, + + /* instance.c */ +#ifdef CLOS + {"SI::ALLOCATE-INSTANCE", SW("siLallocate_instance",siLallocate_instance,si)}, + {"SI::CHANGE-INSTANCE", SW("siLchange_instance",siLchange_instance,si)}, + {"SI::INSTANCE-REF-SAFE", SW("siLinstance_ref_safe",siLinstance_ref_safe,si)}, + {"SI::INSTANCE-REF", SW("siLinstance_ref",siLinstance_ref,si)}, + {"SI::INSTANCE-SET", SW("siLinstance_set",siLinstance_set,si)}, + {"SI::INSTANCE-CLASS", SW("siLinstance_class",siLinstance_class,si)}, + {"SI::INSTANCE-CLASS-SET", SW("siLinstance_class_set",siLinstance_class_set,si)}, + {"SI::INSTANCEP", SW("siLinstancep",siLinstancep,si)}, + {"SI::UNBOUND", SW("siLunbound",siLunbound,si)}, + {"SI::SL-BOUNDP", SW("siLsl_boundp",siLsl_boundp,si)}, + {"SI::SL-MAKUNBOUND", SW("siLsl_makunbound",siLsl_makunbound,si)}, +#endif /* CLOS */ + + /* interpreter.c */ + {"SI::INTERPRETER-STACK", SW("siLinterpreter_stack",siLinterpreter_stack,si)}, + {"SI::MAKE-LAMBDA", SW("siLmake_lambda",siLmake_lambda,si)}, + {"SI::FUNCTION-BLOCK-NAME", SW("siLfunction_block_name",siLfunction_block_name,si)}, + + /* iteration.c */ + + {"DO", SW("NULL",NULL,form)}, + {"DO*", SW("NULL",NULL,form)}, + {"DOLIST", SW("NULL",NULL,form)}, + {"DOTIMES", SW("NULL",NULL,form)}, + + /* let.c */ + + {"LET", SW("NULL",NULL,form)}, + {"LET*", SW("NULL",NULL,form)}, + {"MULTIPLE-VALUE-BIND", SW("NULL",NULL,form)}, + {"COMPILER-LET", SW("NULL",NULL,form)}, + {"FLET", SW("NULL",NULL,form)}, + {"LABELS", SW("NULL",NULL,form)}, + {"MACROLET", SW("NULL",NULL,form)}, + {"SYMBOL-MACROLET", SW("NULL",NULL,form)}, + + /* list.d */ + + {"CAR", SW("clLcar",clLcar,cl)}, + {"CDR", SW("clLcdr",clLcdr,cl)}, + {"CAAR", SW("clLcaar",clLcaar,cl)}, + {"CADR", SW("clLcadr",clLcadr,cl)}, + {"CDAR", SW("clLcdar",clLcdar,cl)}, + {"CDDR", SW("clLcddr",clLcddr,cl)}, + {"CAAAR", SW("clLcaaar",clLcaaar,cl)}, + {"CAADR", SW("clLcaadr",clLcaadr,cl)}, + {"CADAR", SW("clLcadar",clLcadar,cl)}, + {"CADDR", SW("clLcaddr",clLcaddr,cl)}, + {"CDAAR", SW("clLcdaar",clLcdaar,cl)}, + {"CDADR", SW("clLcdadr",clLcdadr,cl)}, + {"CDDAR", SW("clLcddar",clLcddar,cl)}, + {"CDDDR", SW("clLcdddr",clLcdddr,cl)}, + {"CAAAAR", SW("clLcaaaar",clLcaaaar,cl)}, + {"CAAADR", SW("clLcaaadr",clLcaaadr,cl)}, + {"CAADAR", SW("clLcaadar",clLcaadar,cl)}, + {"CAADDR", SW("clLcaaddr",clLcaaddr,cl)}, + {"CADAAR", SW("clLcadaar",clLcadaar,cl)}, + {"CADADR", SW("clLcadadr",clLcadadr,cl)}, + {"CADDAR", SW("clLcaddar",clLcaddar,cl)}, + {"CADDDR", SW("clLcadddr",clLcadddr,cl)}, + {"CDAAAR", SW("clLcdaaar",clLcdaaar,cl)}, + {"CDAADR", SW("clLcdaadr",clLcdaadr,cl)}, + {"CDADAR", SW("clLcdadar",clLcdadar,cl)}, + {"CDADDR", SW("clLcdaddr",clLcdaddr,cl)}, + {"CDDAAR", SW("clLcddaar",clLcddaar,cl)}, + {"CDDADR", SW("clLcddadr",clLcddadr,cl)}, + {"CDDDAR", SW("clLcdddar",clLcdddar,cl)}, + {"CDDDDR", SW("clLcddddr",clLcddddr,cl)}, + + {"CONS", SW("clLcons",clLcons,cl)}, + {"TREE-EQUAL", SW("clLtree_equal",clLtree_equal,cl)}, + {"ENDP", SW("clLendp",clLendp,cl)}, + {"LIST-LENGTH", SW("clLlist_length",clLlist_length,cl)}, + {"NTH", SW("clLnth",clLnth,cl)}, + + {"FIRST", SW("clLcar",clLcar,cl)}, + {"SECOND", SW("clLcadr",clLcadr,cl)}, + {"THIRD", SW("clLcaddr",clLcaddr,cl)}, + {"FOURTH", SW("clLcadddr",clLcadddr,cl)}, + {"FIFTH", SW("clLfifth",clLfifth,cl)}, + {"SIXTH", SW("clLsixth",clLsixth,cl)}, + {"SEVENTH", SW("clLseventh",clLseventh,cl)}, + {"EIGHTH", SW("clLeighth",clLeighth,cl)}, + {"NINTH", SW("clLninth",clLninth,cl)}, + {"TENTH", SW("clLtenth",clLtenth,cl)}, + + {"REST", SW("clLcdr",clLcdr,cl)}, + {"NTHCDR", SW("clLnthcdr",clLnthcdr,cl)}, + {"LAST", SW("clLlast",clLlast,cl)}, + {"LIST", SW("clLlist",clLlist,cl)}, + {"LIST*", SW("clLlistX",clLlistX,cl)}, + {"MAKE-LIST", SW("clLmake_list",clLmake_list,cl)}, + {"APPEND", SW("clLappend",clLappend,cl)}, + {"COPY-LIST", SW("clLcopy_list",clLcopy_list,cl)}, + {"COPY-ALIST", SW("clLcopy_alist",clLcopy_alist,cl)}, + {"COPY-TREE", SW("clLcopy_tree",clLcopy_tree,cl)}, + {"REVAPPEND", SW("clLrevappend",clLrevappend,cl)}, + {"NCONC", SW("clLnconc",clLnconc,cl)}, + {"NRECONC", SW("clLnreconc",clLnreconc,cl)}, + + {"BUTLAST", SW("clLbutlast",clLbutlast,cl)}, + {"NBUTLAST", SW("clLnbutlast",clLnbutlast,cl)}, + {"LDIFF", SW("clLldiff",clLldiff,cl)}, + {"RPLACA", SW("clLrplaca",clLrplaca,cl)}, + {"RPLACD", SW("clLrplacd",clLrplacd,cl)}, + {"SUBST", SW("clLsubst",clLsubst,cl)}, + {"SUBST-IF", SW("clLsubst_if",clLsubst_if,cl)}, + {"SUBST-IF-NOT", SW("clLsubst_if_not",clLsubst_if_not,cl)}, + {"NSUBST", SW("clLnsubst",clLnsubst,cl)}, + {"NSUBST-IF", SW("clLnsubst_if",clLnsubst_if,cl)}, + {"NSUBST-IF-NOT", SW("clLnsubst_if_not",clLnsubst_if_not,cl)}, + {"SUBLIS", SW("clLsublis",clLsublis,cl)}, + {"NSUBLIS", SW("clLnsublis",clLnsublis,cl)}, + {"MEMBER", SW("clLmember",clLmember,cl)}, + {"MEMBER-IF", SW("clLmember_if",clLmember_if,cl)}, + {"MEMBER-IF-NOT", SW("clLmember_if_not",clLmember_if_not,cl)}, + {"SI::MEMBER1", SW("siLmember1",siLmember1,si)}, + {"TAILP", SW("clLtailp",clLtailp,cl)}, + {"ADJOIN", SW("clLadjoin",clLadjoin,cl)}, + + {"ACONS", SW("clLacons",clLacons,cl)}, + {"PAIRLIS", SW("clLpairlis",clLpairlis,cl)}, + {"ASSOC", SW("clLassoc",clLassoc,cl)}, + {"ASSOC-IF", SW("clLassoc_if",clLassoc_if,cl)}, + {"ASSOC-IF-NOT", SW("clLassoc_if_not",clLassoc_if_not,cl)}, + {"RASSOC", SW("clLrassoc",clLrassoc,cl)}, + {"RASSOC-IF", SW("clLrassoc_if",clLrassoc_if,cl)}, + {"RASSOC-IF-NOT", SW("clLrassoc_if_not",clLrassoc_if_not,cl)}, + + {"SI::MEMQ", SW("siLmemq",siLmemq,si)}, + + /* load.d */ + + {"LOAD", SW("clLload",clLload,cl)}, +#ifdef ENABLE_DLOPEN + {"SI::LOAD-BINARY", SW("siLload_binary",siLload_binary,si)}, +#endif + {"SI::LOAD-SOURCE", SW("siLload_source",siLload_source,si)}, + + /* lwp.d */ +#ifdef THREADS + {"SI::THREAD-BREAK-IN", SW("siLthread_break_in",siLthread_break_in,si)}, + {"SI::THREAD-BREAK-QUIT", SW("siLthread_break_quit",siLthread_break_quit,si)}, + {"SI::THREAD-BREAK-RESUME", SW("siLthread_break_resume",siLthread_break_resume,si)}, + {"MAKE-THREAD", SW("clLmake_thread",clLmake_thread,cl)}, + {"DEACTIVATE", SW("clLdeactivate",clLdeactivate,cl)}, + {"REACTIVATE", SW("clLreactivate",clLreactivate,cl)}, + {"KILL-THREAD", SW("clLkill_thread",clLkill_thread,cl)}, + {"CURRENT-THREAD", SW("clLcurrent_thread",clLcurrent_thread,cl)}, + {"THREAD-STATUS", SW("clLthread_status",clLthread_status,cl)}, + {"THREAD-LIST", SW("clLthread_list",clLthread_list,cl)}, + {"MAKE-CONTINUATION", SW("clLmake_continuation",clLmake_continuation,cl)}, + {"THREAD-OF", SW("clLthread_of",clLthread_of,cl)}, + {"CONTINUATION-OF", SW("clLcontinuation_of",clLcontinuation_of,cl)}, + {"RESUME", SW("clLresume",clLresume,cl)}, + + {"%DISABLE-SCHEDULER", SW("clLdisable_scheduler",clLdisable_scheduler,cl)}, + {"%ENABLE-SCHEDULER", SW("clLenable_scheduler",clLenable_scheduler,cl)}, + {"%SUSPEND", SW("clLsuspend",clLsuspend,cl)}, + {"%DELAY", SW("clLdelay",clLdelay,cl)}, + {"%THREAD-WAIT", SW("clLthread_wait",clLthread_wait,cl)}, + {"%THREAD-WAIT-WITH-TIMEOUT", SW("clLthread_wait_with_timeout",clLthread_wait_with_timeout,cl)}, +#endif /* THREADS */ + + /* macros.c */ + + {"MACROEXPAND", SW("clLmacroexpand",clLmacroexpand,cl)}, + {"MACROEXPAND-1", SW("clLmacroexpand_1",clLmacroexpand_1,cl)}, + + /* main.c */ + + {"QUIT", SW("clLquit",clLquit,cl)}, + {"SI::ARGC", SW("siLargc",siLargc,si)}, + {"SI::ARGV", SW("siLargv",siLargv,si)}, + {"SI::GETENV", SW("siLgetenv",siLgetenv,si)}, + {"SI::SETENV", SW("siLsetenv",siLsetenv,si)}, + {"SI::POINTER", SW("siLpointer",siLpointer,si)}, + + /* mapfun.c */ + + {"MAPCAR", SW("clLmapcar",clLmapcar,cl)}, + {"MAPLIST", SW("clLmaplist",clLmaplist,cl)}, + {"MAPC", SW("clLmapc",clLmapc,cl)}, + {"MAPL", SW("clLmapl",clLmapl,cl)}, + {"MAPCAN", SW("clLmapcan",clLmapcan,cl)}, + {"MAPCON", SW("clLmapcon",clLmapcon,cl)}, + + /* multival.c */ + + {"VALUES", SW("clLvalues",clLvalues,cl)}, + {"VALUES-LIST", SW("clLvalues_list",clLvalues_list,cl)}, + {"MULTIPLE-VALUE-CALL", SW("NULL",NULL,form)}, + {"MULTIPLE-VALUE-PROG1", SW("NULL",NULL,form)}, + {"MULTIPLE-VALUE-LIST", SW("NULL",NULL,form)}, + {"NTH-VALUE", SW("NULL",NULL,form)}, + + + /* num-arith.c */ + + {"+", SW("clLP",clLP,cl)}, + {"-", SW("clLM",clLM,cl)}, + {"*", SW("clLX",clLX,cl)}, + {"/", SW("clLN",clLN,cl)}, + {"1+", SW("clL1P",clL1P,cl)}, + {"1-", SW("clL1M",clL1M,cl)}, + {"CONJUGATE", SW("clLconjugate",clLconjugate,cl)}, + {"GCD", SW("clLgcd",clLgcd,cl)}, + {"LCM", SW("clLlcm",clLlcm,cl)}, + + + /* num_co.c */ + + {"FLOAT", SW("clLfloat",clLfloat,cl)}, + {"NUMERATOR", SW("clLnumerator",clLnumerator,cl)}, + {"DENOMINATOR", SW("clLdenominator",clLdenominator,cl)}, + {"FLOOR", SW("clLfloor",clLfloor,cl)}, + {"CEILING", SW("clLceiling",clLceiling,cl)}, + {"TRUNCATE", SW("clLtruncate",clLtruncate,cl)}, + {"ROUND", SW("clLround",clLround,cl)}, + {"MOD", SW("clLmod",clLmod,cl)}, + {"REM", SW("clLrem",clLrem,cl)}, + {"DECODE-FLOAT", SW("clLdecode_float",clLdecode_float,cl)}, + {"SCALE-FLOAT", SW("clLscale_float",clLscale_float,cl)}, + {"FLOAT-RADIX", SW("clLfloat_radix",clLfloat_radix,cl)}, + {"FLOAT-SIGN", SW("clLfloat_sign",clLfloat_sign,cl)}, + {"FLOAT-DIGITS", SW("clLfloat_digits",clLfloat_digits,cl)}, + {"FLOAT-PRECISION", SW("clLfloat_precision",clLfloat_precision,cl)}, + {"INTEGER-DECODE-FLOAT", SW("clLinteger_decode_float",clLinteger_decode_float,cl)}, + {"COMPLEX", SW("clLcomplex",clLcomplex,cl)}, + {"REALPART", SW("clLrealpart",clLrealpart,cl)}, + {"IMAGPART", SW("clLimagpart",clLimagpart,cl)}, + + /* num_comp.c */ + + {"=", SW("clLE",clLE,cl)}, + {"/=", SW("clLNE",clLNE,cl)}, + {"<", SW("clLL",clLL,cl)}, + {">", SW("clLG",clLG,cl)}, + {"<=", SW("clLLE",clLLE,cl)}, + {">=", SW("clLGE",clLGE,cl)}, + {"MAX", SW("clLmax",clLmax,cl)}, + {"MIN", SW("clLmin",clLmin,cl)}, + + /* num_log.c */ + + {"LOGIOR", SW("clLlogior",clLlogior,cl)}, + {"LOGXOR", SW("clLlogxor",clLlogxor,cl)}, + {"LOGAND", SW("clLlogand",clLlogand,cl)}, + {"LOGEQV", SW("clLlogeqv",clLlogeqv,cl)}, + {"LOGNAND", SW("clLlognand",clLlognand,cl)}, + {"LOGNOR", SW("clLlognor",clLlognor,cl)}, + {"LOGANDC1", SW("clLlogandc1",clLlogandc1,cl)}, + {"LOGANDC2", SW("clLlogandc2",clLlogandc2,cl)}, + {"LOGORC1", SW("clLlogorc1",clLlogorc1,cl)}, + {"LOGORC2", SW("clLlogorc2",clLlogorc2,cl)}, + {"LOGNOT", SW("clLlognot",clLlognot,cl)}, + {"BOOLE", SW("clLboole",clLboole,cl)}, + {"LOGBITP", SW("clLlogbitp",clLlogbitp,cl)}, + {"ASH", SW("clLash",clLash,cl)}, + {"LOGCOUNT", SW("clLlogcount",clLlogcount,cl)}, + {"INTEGER-LENGTH", SW("clLinteger_length",clLinteger_length,cl)}, + {"SI::BIT-ARRAY-OP", SW("siLbit_array_op",siLbit_array_op,si)}, + + /* num_pred.c */ + + {"ZEROP", SW("clLzerop",clLzerop,cl)}, + {"PLUSP", SW("clLplusp",clLplusp,cl)}, + {"MINUSP", SW("clLminusp",clLminusp,cl)}, + {"ODDP", SW("clLoddp",clLoddp,cl)}, + {"EVENP", SW("clLevenp",clLevenp,cl)}, + + /* num_rand.c */ + + {"RANDOM", SW("clLrandom",clLrandom,cl)}, + {"MAKE-RANDOM-STATE", SW("clLmake_random_state",clLmake_random_state,cl)}, + {"RANDOM-STATE-P", SW("clLrandom_state_p",clLrandom_state_p,cl)}, + + /* num_sfun.c */ + + {"EXP", SW("clLexp",clLexp,cl)}, + {"EXPT", SW("clLexpt",clLexpt,cl)}, + {"LOG", SW("clLlog",clLlog,cl)}, + {"SQRT", SW("clLsqrt",clLsqrt,cl)}, + {"SIN", SW("clLsin",clLsin,cl)}, + {"COS", SW("clLcos",clLcos,cl)}, + {"TAN", SW("clLtan",clLtan,cl)}, + {"ATAN", SW("clLatan",clLatan,cl)}, + {"SINH", SW("clLsinh",clLsinh,cl)}, + {"COSH", SW("clLcosh",clLcosh,cl)}, + {"TANH", SW("clLtanh",clLtanh,cl)}, + + /* package.d */ + + {"MAKE-PACKAGE", SW("clLmake_package",clLmake_package,cl)}, + {"SI::SELECT-PACKAGE", SW("siLselect_package",siLselect_package,si)}, + {"FIND-PACKAGE", SW("clLfind_package",clLfind_package,cl)}, + {"PACKAGE-NAME", SW("clLpackage_name",clLpackage_name,cl)}, + {"PACKAGE-NICKNAMES", SW("clLpackage_nicknames",clLpackage_nicknames,cl)}, + {"RENAME-PACKAGE", SW("clLrename_package",clLrename_package,cl)}, + {"PACKAGE-USE-LIST", SW("clLpackage_use_list",clLpackage_use_list,cl)}, + {"PACKAGE-USED-BY-LIST", SW("clLpackage_used_by_list",clLpackage_used_by_list,cl)}, + {"PACKAGE-SHADOWING-SYMBOLS", SW("clLpackage_shadowing_symbols",clLpackage_shadowing_symbols,cl)}, + {"LIST-ALL-PACKAGES", SW("clLlist_all_packages",clLlist_all_packages,cl)}, + {"INTERN", SW("clLintern",clLintern,cl)}, + {"FIND-SYMBOL", SW("clLfind_symbol",clLfind_symbol,cl)}, + {"UNINTERN", SW("clLunintern",clLunintern,cl)}, + {"EXPORT", SW("clLexport",clLexport,cl)}, + {"UNEXPORT", SW("clLunexport",clLunexport,cl)}, + {"IMPORT", SW("clLimport",clLimport,cl)}, + {"SHADOWING-IMPORT", SW("clLshadowing_import",clLshadowing_import,cl)}, + {"SHADOW", SW("clLshadow",clLshadow,cl)}, + {"USE-PACKAGE", SW("clLuse_package",clLuse_package,cl)}, + {"UNUSE-PACKAGE", SW("clLunuse_package",clLunuse_package,cl)}, + {"DELETE-PACKAGE", SW("clLdelete_package",clLdelete_package,cl)}, + + {"SI::PACKAGE-SIZE", SW("siLpackage_size",siLpackage_size,si)}, + {"SI::PACKAGE-INTERNAL", SW("siLpackage_internal",siLpackage_internal,si)}, + {"SI::PACKAGE-EXTERNAL", SW("siLpackage_external",siLpackage_external,si)}, + {"SI::PACKAGE-LOCK", SW("siLpackage_lock",siLpackage_lock,si)}, + + /* pathname.d */ + + {"PATHNAME", SW("clLpathname",clLpathname,cl)}, + {"PARSE-NAMESTRING", SW("clLparse_namestring",clLparse_namestring,cl)}, + {"MERGE-PATHNAMES", SW("clLmerge_pathnames",clLmerge_pathnames,cl)}, + {"MAKE-PATHNAME", SW("clLmake_pathname",clLmake_pathname,cl)}, + {"PATHNAMEP", SW("clLpathnamep",clLpathnamep,cl)}, + {"PATHNAME-HOST", SW("clLpathname_host",clLpathname_host,cl)}, + {"PATHNAME-DEVICE", SW("clLpathname_device",clLpathname_device,cl)}, + {"PATHNAME-DIRECTORY", SW("clLpathname_directory",clLpathname_directory,cl)}, + {"PATHNAME-NAME", SW("clLpathname_name",clLpathname_name,cl)}, + {"PATHNAME-TYPE", SW("clLpathname_type",clLpathname_type,cl)}, + {"PATHNAME-VERSION", SW("clLpathname_version",clLpathname_version,cl)}, + {"NAMESTRING", SW("clLnamestring",clLnamestring,cl)}, + {"FILE-NAMESTRING", SW("clLfile_namestring",clLfile_namestring,cl)}, + {"DIRECTORY-NAMESTRING", SW("clLdirectory_namestring",clLdirectory_namestring,cl)}, + {"HOST-NAMESTRING", SW("clLhost_namestring",clLhost_namestring,cl)}, + {"ENOUGH-NAMESTRING", SW("clLenough_namestring",clLenough_namestring,cl)}, + {"SI::LOGICAL-PATHNAME-P", SW("siLlogical_pathname_p",siLlogical_pathname_p,si)}, + {"PATHNAME-MATCH-P", SW("clLpathname_match_p",clLpathname_match_p,cl)}, + {"TRANSLATE-PATHNAME", SW("clLtranslate_pathname",clLtranslate_pathname,cl)}, + {"TRANSLATE-LOGICAL-PATHNAME", SW("clLtranslate_logical_pathname",clLtranslate_logical_pathname,cl)}, + {"SI::PATHNAME-TRANSLATIONS", SW("siLpathname_translations",siLpathname_translations,si)}, + + /* predicate.c */ + + {"IDENTITY", SW("clLidentity",clLidentity,cl)}, + {"NULL", SW("clLnull",clLnull,cl)}, + {"SYMBOLP", SW("clLsymbolp",clLsymbolp,cl)}, + {"ATOM", SW("clLatom",clLatom,cl)}, + {"CONSP", SW("clLconsp",clLconsp,cl)}, + {"LISTP", SW("clLlistp",clLlistp,cl)}, + {"NUMBERP", SW("clLnumberp",clLnumberp,cl)}, + {"INTEGERP", SW("clLintegerp",clLintegerp,cl)}, + {"RATIONALP", SW("clLrationalp",clLrationalp,cl)}, + {"FLOATP", SW("clLfloatp",clLfloatp,cl)}, + {"REALP", SW("clLrealp",clLrealp,cl)}, + {"COMPLEXP", SW("clLcomplexp",clLcomplexp,cl)}, + {"CHARACTERP", SW("clLcharacterp",clLcharacterp,cl)}, + {"STRINGP", SW("clLstringp",clLstringp,cl)}, + {"BIT-VECTOR-P", SW("clLbit_vector_p",clLbit_vector_p,cl)}, + {"VECTORP", SW("clLvectorp",clLvectorp,cl)}, + {"SIMPLE-STRING-P", SW("clLsimple_string_p",clLsimple_string_p,cl)}, + {"SIMPLE-BIT-VECTOR-P", SW("clLsimple_bit_vector_p",clLsimple_bit_vector_p,cl)}, + {"SIMPLE-VECTOR-P", SW("clLsimple_vector_p",clLsimple_vector_p,cl)}, + {"ARRAYP", SW("clLarrayp",clLarrayp,cl)}, + {"PACKAGEP", SW("clLpackagep",clLpackagep,cl)}, + {"FUNCTIONP", SW("clLfunctionp",clLfunctionp,cl)}, + {"COMPILED-FUNCTION-P", SW("clLcompiled_function_p",clLcompiled_function_p,cl)}, + {"COMMONP", SW("clLcommonp",clLcommonp,cl)}, + + {"EQ", SW("clLeq",clLeq,cl)}, + {"EQL", SW("clLeql",clLeql,cl)}, + {"EQUAL", SW("clLequal",clLequal,cl)}, + {"EQUALP", SW("clLequalp",clLequalp,cl)}, + + {"NOT", SW("clLnull",clLnull,cl)}, + + {"SI::FIXNUMP", SW("siLfixnump",siLfixnump,si)}, + + /* print.d */ + + {"WRITE", SW("clLwrite",clLwrite,cl)}, + {"PRIN1", SW("clLprin1",clLprin1,cl)}, + {"PRINT", SW("clLprint",clLprint,cl)}, + {"PPRINT", SW("clLpprint",clLpprint,cl)}, + {"PRINC", SW("clLprinc",clLprinc,cl)}, + {"WRITE-CHAR", SW("clLwrite_char",clLwrite_char,cl)}, + {"WRITE-STRING", SW("clLwrite_string",clLwrite_string,cl)}, + {"WRITE-LINE", SW("clLwrite_line",clLwrite_line,cl)}, + {"WRITE-BYTE", SW("clLwrite_byte",clLwrite_byte,cl)}, + {"SI::WRITE-BYTES", SW("siLwrite_bytes",siLwrite_bytes,si)}, + {"TERPRI", SW("clLterpri",clLterpri,cl)}, + {"FRESH-LINE", SW("clLfresh_line",clLfresh_line,cl)}, + {"FINISH-OUTPUT", SW("clLforce_output",clLforce_output,cl)}, + {"FORCE-OUTPUT", SW("clLforce_output",clLforce_output,cl)}, + {"CLEAR-OUTPUT", SW("clLclear_output",clLclear_output,cl)}, + + /* profile.c */ +#ifdef PROFILE + {"SI::PROFILE", SW("siLprofile",siLprofile,si)}, + {"SI::CLEAR-PROFILE", SW("siLclear_profile",siLclear_profile,si)}, + {"SI::DISPLAY-PROFILE", SW("siLdisplay_profile",siLdisplay_profile,si)}, +#endif /* PROFILE */ + + /* prog.c */ + + {"TAGBODY", SW("NULL",NULL,form)}, + {"PROG", SW("NULL",NULL,form)}, + {"PROG*", SW("NULL",NULL,form)}, + {"GO", SW("NULL",NULL,form)}, + {"PROGV", SW("NULL",NULL,form)}, + {"PROGN", SW("NULL",NULL,form)}, + {"PROG1", SW("NULL",NULL,form)}, + {"PROG2", SW("NULL",NULL,form)}, + + /* read.d */ + + {"READ", SW("clLread",clLread,cl)}, + {"READ-PRESERVING-WHITESPACE", SW("clLread_preserving_whitespace",clLread_preserving_whitespace,cl)}, + {"READ-DELIMITED-LIST", SW("clLread_delimited_list",clLread_delimited_list,cl)}, + {"READ-LINE", SW("clLread_line",clLread_line,cl)}, + {"READ-CHAR", SW("clLread_char",clLread_char,cl)}, + {"UNREAD-CHAR", SW("clLunread_char",clLunread_char,cl)}, + {"PEEK-CHAR", SW("clLpeek_char",clLpeek_char,cl)}, + {"LISTEN", SW("clLlisten",clLlisten,cl)}, + {"READ-CHAR-NO-HANG", SW("clLread_char_no_hang",clLread_char_no_hang,cl)}, + {"CLEAR-INPUT", SW("clLclear_input",clLclear_input,cl)}, + + {"PARSE-INTEGER", SW("clLparse_integer",clLparse_integer,cl)}, + + {"READ-BYTE", SW("clLread_byte",clLread_byte,cl)}, + {"SI::READ-BYTES", SW("siLread_bytes",siLread_bytes,si)}, + + {"COPY-READTABLE", SW("clLcopy_readtable",clLcopy_readtable,cl)}, + {"READTABLEP", SW("clLreadtablep",clLreadtablep,cl)}, + {"SET-SYNTAX-FROM-CHAR", SW("clLset_syntax_from_char",clLset_syntax_from_char,cl)}, + {"SET-MACRO-CHARACTER", SW("clLset_macro_character",clLset_macro_character,cl)}, + {"GET-MACRO-CHARACTER", SW("clLget_macro_character",clLget_macro_character,cl)}, + {"MAKE-DISPATCH-MACRO-CHARACTER", SW("clLmake_dispatch_macro_character",clLmake_dispatch_macro_character,cl)}, + {"SET-DISPATCH-MACRO-CHARACTER", SW("clLset_dispatch_macro_character",clLset_dispatch_macro_character,cl)}, + {"GET-DISPATCH-MACRO-CHARACTER", SW("clLget_dispatch_macro_character",clLget_dispatch_macro_character,cl)}, + {"SI::STRING-TO-OBJECT", SW("siLstring_to_object",siLstring_to_object,si)}, + {"SI::STANDARD-READTABLE", SW("siLstandard_readtable",siLstandard_readtable,si)}, + + /* reference.c */ + + {"SYMBOL-FUNCTION", SW("clLsymbol_function",clLsymbol_function,cl)}, + {"FBOUNDP", SW("clLfboundp",clLfboundp,cl)}, + {"QUOTE", SW("NULL",NULL,form)}, + {"SYMBOL-VALUE", SW("clLsymbol_value",clLsymbol_value,cl)}, + {"BOUNDP", SW("clLboundp",clLboundp,cl)}, + {"MACRO-FUNCTION", SW("clLmacro_function",clLmacro_function,cl)}, + {"SPECIAL-FORM-P", SW("clLspecial_form_p",clLspecial_form_p,cl)}, + {"SI::COERCE-TO-FUNCTION", SW("siLcoerce_to_function",siLcoerce_to_function,si)}, + {"FUNCTION", SW("NULL",NULL,form)}, + {"SI::PROCESS-DECLARATIONS", SW("siLprocess_declarations",siLprocess_declarations,si)}, + {"SI::PROCESS-LAMBDA-LIST", SW("siLprocess_lambda_list",siLprocess_lambda_list,si)}, + + /* sequence.d */ + + {"ELT", SW("clLelt",clLelt,cl)}, + {"SI::ELT-SET", SW("siLelt_set",siLelt_set,si)}, + {"SUBSEQ", SW("clLsubseq",clLsubseq,cl)}, + {"COPY-SEQ", SW("clLcopy_seq",clLcopy_seq,cl)}, + {"LENGTH", SW("clLlength",clLlength,cl)}, + {"REVERSE", SW("clLreverse",clLreverse,cl)}, + {"NREVERSE", SW("clLnreverse",clLnreverse,cl)}, + + /* stacks.c */ + + {"SI::IHS-TOP", SW("siLihs_top",siLihs_top,si)}, + {"SI::IHS-FUN", SW("siLihs_fun",siLihs_fun,si)}, + {"SI::IHS-ENV", SW("siLihs_env",siLihs_env,si)}, + {"SI::IHS-NEXT", SW("siLihs_next",siLihs_next,si)}, + {"SI::IHS-PREV", SW("siLihs_prev",siLihs_prev,si)}, + {"SI::FRS-TOP", SW("siLfrs_top",siLfrs_top,si)}, + {"SI::FRS-BDS", SW("siLfrs_bds",siLfrs_bds,si)}, + {"SI::FRS-CLASS", SW("siLfrs_class",siLfrs_class,si)}, + {"SI::FRS-TAG", SW("siLfrs_tag",siLfrs_tag,si)}, + {"SI::FRS-IHS", SW("siLfrs_ihs",siLfrs_ihs,si)}, + {"SI::BDS-TOP", SW("siLbds_top",siLbds_top,si)}, + {"SI::BDS-VAR", SW("siLbds_var",siLbds_var,si)}, + {"SI::BDS-VAL", SW("siLbds_val",siLbds_val,si)}, + {"SI::SCH-FRS-BASE", SW("siLsch_frs_base",siLsch_frs_base,si)}, + {"SI::RESET-STACK-LIMITS", SW("siLreset_stack_limits",siLreset_stack_limits,si)}, + + /* string.d */ + + {"CHAR", SW("clLchar",clLchar,cl)}, + {"SI::CHAR-SET", SW("siLchar_set",siLchar_set,si)}, + {"SCHAR", SW("clLchar",clLchar,cl)}, + {"SI::SCHAR-SET", SW("siLchar_set",siLchar_set,si)}, + {"STRING=", SW("clLstringE",clLstringE,cl)}, + {"STRING-EQUAL", SW("clLstring_equal",clLstring_equal,cl)}, + {"STRING<", SW("clLstringL",clLstringL,cl)}, + {"STRING>", SW("clLstringG",clLstringG,cl)}, + {"STRING<=", SW("clLstringLE",clLstringLE,cl)}, + {"STRING>=", SW("clLstringGE",clLstringGE,cl)}, + {"STRING/=", SW("clLstringNE",clLstringNE,cl)}, + {"STRING-LESSP", SW("clLstring_lessp",clLstring_lessp,cl)}, + {"STRING-GREATERP", SW("clLstring_greaterp",clLstring_greaterp,cl)}, + {"STRING-NOT-LESSP", SW("clLstring_not_lessp",clLstring_not_lessp,cl)}, + {"STRING-NOT-GREATERP", SW("clLstring_not_greaterp",clLstring_not_greaterp,cl)}, + {"STRING-NOT-EQUAL", SW("clLstring_not_equal",clLstring_not_equal,cl)}, + {"MAKE-STRING", SW("clLmake_string",clLmake_string,cl)}, + {"STRING-TRIM", SW("clLstring_trim",clLstring_trim,cl)}, + {"STRING-LEFT-TRIM", SW("clLstring_left_trim",clLstring_left_trim,cl)}, + {"STRING-RIGHT-TRIM", SW("clLstring_right_trim",clLstring_right_trim,cl)}, + {"STRING-UPCASE", SW("clLstring_upcase",clLstring_upcase,cl)}, + {"STRING-DOWNCASE", SW("clLstring_downcase",clLstring_downcase,cl)}, + {"STRING-CAPITALIZE", SW("clLstring_capitalize",clLstring_capitalize,cl)}, + {"NSTRING-UPCASE", SW("clLnstring_upcase",clLnstring_upcase,cl)}, + {"NSTRING-DOWNCASE", SW("clLnstring_downcase",clLnstring_downcase,cl)}, + {"NSTRING-CAPITALIZE", SW("clLnstring_capitalize",clLnstring_capitalize,cl)}, + {"STRING", SW("clLstring",clLstring,cl)}, + {"SI::STRING-CONCATENATE", SW("siLstring_concatenate",siLstring_concatenate,si)}, + + /* structure.c */ + + {"SI::MAKE-STRUCTURE", SW("siLmake_structure",siLmake_structure,si)}, + {"SI::COPY-STRUCTURE", SW("siLcopy_structure",siLcopy_structure,si)}, + {"SI::STRUCTURE-NAME", SW("siLstructure_name",siLstructure_name,si)}, + {"SI::STRUCTURE-REF", SW("siLstructure_ref",siLstructure_ref,si)}, + {"SI::STRUCTURE-SET", SW("siLstructure_set",siLstructure_set,si)}, + {"SI::STRUCTUREP", SW("siLstructurep",siLstructurep,si)}, + {"SI::STRUCTURE-SUBTYPE-P", SW("siLstructure_subtype_p",siLstructure_subtype_p,si)}, + {"SI::RPLACA-NTHCDR", SW("siLrplaca_nthcdr",siLrplaca_nthcdr,si)}, + {"SI::LIST-NTH", SW("siLlist_nth",siLlist_nth,si)}, + + /* symbol.d */ + + {"GET", SW("clLget",clLget,cl)}, + {"REMPROP", SW("clLremprop",clLremprop,cl)}, + {"SYMBOL-PLIST", SW("clLsymbol_plist",clLsymbol_plist,cl)}, + {"GETF", SW("clLgetf",clLgetf,cl)}, + {"GET-PROPERTIES", SW("clLget_properties",clLget_properties,cl)}, + {"SYMBOL-NAME", SW("clLsymbol_name",clLsymbol_name,cl)}, + {"MAKE-SYMBOL", SW("clLmake_symbol",clLmake_symbol,cl)}, + {"COPY-SYMBOL", SW("clLcopy_symbol",clLcopy_symbol,cl)}, + {"GENSYM", SW("clLgensym",clLgensym,cl)}, + {"GENTEMP", SW("clLgentemp",clLgentemp,cl)}, + {"SYMBOL-PACKAGE", SW("clLsymbol_package",clLsymbol_package,cl)}, + {"KEYWORDP", SW("clLkeywordp",clLkeywordp,cl)}, + {"SI::PUT-F", SW("siLput_f",siLput_f,si)}, + {"SI::REM-F", SW("siLrem_f",siLrem_f,si)}, + {"SI::SET-SYMBOL-PLIST", SW("siLset_symbol_plist",siLset_symbol_plist,si)}, + {"SI::PUTPROP", SW("siLputprop",siLputprop,si)}, + {"SI::PUT-PROPERTIES", SW("siLput_properties",siLput_properties,si)}, + + /* tcp.c */ +#ifdef TCP + {"SI::OPEN-CLIENT-STREAM", SW("siLopen_client_stream",siLopen_client_stream,si)}, + {"SI::OPEN-SERVER-STREAM", SW("siLopen_server_stream",siLopen_server_stream,si)}, +#endif + + /* time.c */ + + {"GET-UNIVERSAL-TIME", SW("clLget_universal_time",clLget_universal_time,cl)}, + {"SLEEP", SW("clLsleep",clLsleep,cl)}, + {"GET-INTERNAL-RUN-TIME", SW("clLget_internal_run_time",clLget_internal_run_time,cl)}, + {"GET-INTERNAL-REAL-TIME", SW("clLget_internal_real_time",clLget_internal_real_time,cl)}, + {"SI::GET-LOCAL-TIME-ZONE", SW("siLget_local_time_zone",siLget_local_time_zone,si)}, + {"SI::DAYLIGHT-SAVING-TIME-P", SW("siLdaylight_saving_time_p",siLdaylight_saving_time_p,si)}, + + /* toplevel.c */ + + {"LAMBDA", SW("NULL",NULL,form)}, + {"NAMED-LAMBDA", SW("NULL",NULL,form)}, + {"SI::*MAKE-SPECIAL", SW("siLXmake_special",siLXmake_special,si)}, + {"SI::*MAKE-CONSTANT", SW("siLXmake_constant",siLXmake_constant,si)}, + {"EVAL-WHEN", SW("NULL",NULL,form)}, + {"THE", SW("NULL",NULL,form)}, + {"DECLARE", SW("NULL",NULL,form)}, + {"LOCALLY", SW("NULL",NULL,form)}, + + /* typespec.c */ + + {"TYPE-OF", SW("clLtype_of",clLtype_of,cl)}, + + /* unixint.c */ + +#ifdef unix + {"SI::CATCH-BAD-SIGNALS", SW("siLcatch_bad_signals",siLcatch_bad_signals,si)}, + {"SI::UNCATCH-BAD-SIGNALS", SW("siLuncatch_bad_signals",siLuncatch_bad_signals,si)}, +#endif /* unix */ + + /* unixfsys.c */ + + {"TRUENAME", SW("clLtruename",clLtruename,cl)}, + {"RENAME-FILE", SW("clLrename_file",clLrename_file,cl)}, + {"DELETE-FILE", SW("clLdelete_file",clLdelete_file,cl)}, + {"PROBE-FILE", SW("clLprobe_file",clLprobe_file,cl)}, + {"FILE-WRITE-DATE", SW("clLfile_write_date",clLfile_write_date,cl)}, + {"FILE-AUTHOR", SW("clLfile_author",clLfile_author,cl)}, + {"USER-HOMEDIR-PATHNAME", SW("clLuser_homedir_pathname",clLuser_homedir_pathname,cl)}, + {"SI::STRING-MATCH", SW("siLstring_match",siLstring_match,si)}, + {"DIRECTORY", SW("clLdirectory",clLdirectory,cl)}, + {"SI::CHDIR", SW("siLchdir",siLchdir,si)}, + {"SI::MKDIR", SW("siLmkdir",siLmkdir,si)}, + + /* unixsys.c */ + + {"SI::SYSTEM", SW("siLsystem",siLsystem,si)}, + {"SI::OPEN-PIPE", SW("siLopen_pipe",siLopen_pipe,si)}, + + /* end of list */ + {NULL, SW(NULL, NULL, 0)} +}; + + diff --git a/src/c/gbc.d b/src/c/gbc.d index fc5d9193f..aa006fb59 100644 --- a/src/c/gbc.d +++ b/src/c/gbc.d @@ -21,9 +21,6 @@ /******************************* EXPORTS ******************************/ -cl_object @'si::*gc-verbose*'; -cl_object @'si::*gc-message*'; - bool GC_enable; /******************************* ------- ******************************/ @@ -543,13 +540,9 @@ mark_phase(void) /* mark registered symbols & keywords */ { - const struct keyword_info *k; - const struct symbol_info *s; - for (k = all_keywords; k->loc != NULL; k++) - mark_object(*(k->loc)); - for (s = all_symbols; s->loc != NULL; s++) - mark_object(*(s->loc)); - } + int i; + for (i=0; i 0) arglist = CONS(args[i], arglist); - methods = funcall(3, siScompute_applicable_methods, gf, arglist); - meth_comb = funcall(2, siSgeneric_function_method_combination, gf); - meth_args = funcall(2, siSgeneric_function_method_combination_args,gf); - func = funcall(5, siScompute_effective_method, gf, methods, + methods = funcall(3, @'si::compute-applicable-methods', gf, arglist); + meth_comb = funcall(2, @'si::generic-function-method-combination', gf); + meth_args = funcall(2, @'si::generic-function-method-combination-args', gf); + func = funcall(5, @'si::compute-effective-method', gf, methods, meth_comb, meth_args); /* update cache */ diff --git a/src/c/hash.d b/src/c/hash.d index 3f4d5a228..44cdce085 100644 --- a/src/c/hash.d +++ b/src/c/hash.d @@ -16,15 +16,6 @@ #include "ecl.h" -cl_object @'eq'; -cl_object @'eql'; -cl_object @'equal'; - -cl_object @':size'; -cl_object @':rehash-size'; -cl_object @':rehash-threshold'; - - /******************* * CRC-32 ROUTINES * *******************/ diff --git a/src/c/init.d b/src/c/init.d index 2b2703170..a2455245a 100644 --- a/src/c/init.d +++ b/src/c/init.d @@ -37,7 +37,6 @@ init_lisp(void) #endif /* These must come _after_ init_symbol() and init_package() */ - init_all_keywords(); init_all_symbols(); init_all_functions(); diff --git a/src/c/instance.d b/src/c/instance.d index e420a1f92..f507cdd07 100644 --- a/src/c/instance.d +++ b/src/c/instance.d @@ -15,12 +15,6 @@ #include "ecl.h" -/******************************* EXPORTS ******************************/ - -cl_object @'print-object'; - -/******************************* ------- ******************************/ - cl_object cl_allocate_instance(cl_object clas, int size) { diff --git a/src/c/interpreter.d b/src/c/interpreter.d index 0a87cb79c..5e7e25769 100644 --- a/src/c/interpreter.d +++ b/src/c/interpreter.d @@ -1039,5 +1039,5 @@ init_interpreter(void) { cl_stack = NULL; cl_stack_size = 0; - cl_stack_set_size(8*LISP_PAGESIZE); + cl_stack_set_size(16*LISP_PAGESIZE); } diff --git a/src/c/list.d b/src/c/list.d index a7b8bec35..daafe16d0 100644 --- a/src/c/list.d +++ b/src/c/list.d @@ -17,15 +17,6 @@ #include "ecl.h" #include "ecl-inl.h" -/******************************* EXPORTS ******************************/ - -cl_object @':test'; -cl_object @':test-not'; -cl_object @':key'; -cl_object @':initial-element'; - -/******************************* ------- ******************************/ - #ifdef THREADS #define test_function clwp->lwp_test_function #define item_compared clwp->lwp_item_compared @@ -211,7 +202,7 @@ list(int narg, ...) return(p); } -@(defun listX (&rest args) +@(defun list* (&rest args) cl_object p = Cnil, *z=&p; @ if (narg == 0) diff --git a/src/c/load.d b/src/c/load.d index 139183f6b..217e2b156 100644 --- a/src/c/load.d +++ b/src/c/load.d @@ -20,19 +20,6 @@ #include #endif -/******************************* EXPORTS ******************************/ - -cl_object @':verbose'; -cl_object @'*load-verbose*'; -cl_object @'*load-print*'; -cl_object @'si::*load-hooks*'; -#ifdef PDE -cl_object @'si::*source-pathname*'; -#endif -cl_object @'si::*init-function-prefix*'; - -/******************************* ------- ******************************/ - #ifdef ENABLE_DLOPEN @(defun si::load_binary (filename verbose print) cl_object block; @@ -180,7 +167,7 @@ NOT_A_FILENAME: old_bds_top = bds_top; bds_bind(@'*package*', symbol_value(@'*package*')); #ifdef PDE - bds_bind(@'*source-pathname*', filename); + bds_bind(@'si::*source-pathname*', filename); #endif if (frs_push(FRS_PROTECT, Cnil)) { frs_pop(); diff --git a/src/c/lwp.d b/src/c/lwp.d index 6ebce8007..37e73260f 100644 --- a/src/c/lwp.d +++ b/src/c/lwp.d @@ -24,13 +24,6 @@ pd *running_head; /* front of running pd's */ pd *running_tail; /* back of running pd's */ pd main_pd; -cl_object @'running'; -cl_object @'suspended'; -cl_object @'waiting'; -cl_object @'stopped'; -cl_object @'dead'; -cl_object @'si::thread-top-level'; - /******************************* IMPORTS ******************************/ extern scheduler_interruption; /* in unixint.c */ diff --git a/src/c/macros.d b/src/c/macros.d index 3cfdd5818..b6219e63e 100644 --- a/src/c/macros.d +++ b/src/c/macros.d @@ -20,11 +20,6 @@ /* Requires expand-defmacro, from lsp/defmacro.lsp */ -/******************************* EXPORTS ******************************/ - -cl_object @'*macroexpand-hook*'; -cl_object @'si::expand-defmacro'; - /******************************* ------- ******************************/ /* diff --git a/src/c/main.d b/src/c/main.d index db94e4402..756e9acc4 100644 --- a/src/c/main.d +++ b/src/c/main.d @@ -41,7 +41,6 @@ int data_start = (int)&data_start; /******************************* EXPORTS ******************************/ -cl_object clVfeatures; const char *ecl_self; /******************************* ------- ******************************/ @@ -49,11 +48,6 @@ const char *ecl_self; static int ARGC; static char **ARGV; -#ifdef THREADS -static cl_object @'si::*thread-top*'; -#endif -static cl_object @'si::top-level'; - #if !defined(GBC_BOEHM) static char stdin_buf[BUFSIZ]; static char stdout_buf[BUFSIZ]; @@ -112,7 +106,7 @@ cl_boot(int argc, char **argv) if (clwp != &main_lpd) { VALUES(0) = Cnil; NValues = 0; - cl_throw(@'si::*thread-top*'); + cl_throw(_intern("*thread-top*", system_package)); /* never reached */ } #endif @@ -169,9 +163,6 @@ cl_boot(int argc, char **argv) void init_main(void) { - @'si::top_level' = make_si_ordinary("TOP-LEVEL"); - register_root(&@'si::top-level'); - make_ordinary("LISP-IMPLEMENTATION-VERSION"); { cl_object features; @@ -230,9 +221,6 @@ init_main(void) SYM_VAL(@'*features*') = features; } -#ifdef THREADS - @'si::*thread-top*' = make_si_ordinary("THREAD-TOP"); -#endif make_si_constant("+OBJNULL+", OBJNULL); } diff --git a/src/c/num_comp.d b/src/c/num_comp.d index fc076a4fc..f8057abab 100644 --- a/src/c/num_comp.d +++ b/src/c/num_comp.d @@ -16,13 +16,6 @@ #include "ecl.h" -/* - For sake of profiler, put @all-the-same before number_compare, - so that all calls to number_compare are attributed to function =. - Similarly for @monotonically-decreasing. -*/ - - @(defun = (num &rest nums) int i; @ diff --git a/src/c/num_rand.d b/src/c/num_rand.d index 0c38e4efc..fb1328149 100644 --- a/src/c/num_rand.d +++ b/src/c/num_rand.d @@ -17,8 +17,6 @@ #include "ecl.h" #include -cl_object @'*random-state*'; - static cl_object rando(cl_object x, cl_object rs) { diff --git a/src/c/package.d b/src/c/package.d index 8ea3bb3cd..31b597601 100644 --- a/src/c/package.d +++ b/src/c/package.d @@ -30,13 +30,6 @@ cl_object clos_package; #ifdef TK cl_object tk_package; #endif -cl_object @'*package*'; /* *package* */ - -cl_object @':internal'; -cl_object @':external'; -cl_object @':inherited'; -cl_object @':nicknames'; -cl_object @':use'; /******************************* ------- ******************************/ @@ -926,8 +919,4 @@ init_package(void) Ct->symbol.hpack = lisp_package; cl_import(Ct, lisp_package); cl_export(Ct, lisp_package); - - /* There is no need to enter a package as a mark origin. */ - - @'*package*' = make_special("*PACKAGE*", lisp_package); } diff --git a/src/c/pathname.d b/src/c/pathname.d index 021b4de15..ed1b0b6aa 100644 --- a/src/c/pathname.d +++ b/src/c/pathname.d @@ -30,28 +30,6 @@ # endif #endif -/******************************* EXPORTS ******************************/ - -cl_object @'*default-pathname-defaults*'; -cl_object @':wild'; -cl_object @':wild-inferiors'; -cl_object @':newest'; - -cl_object @':host'; -cl_object @':device'; -cl_object @':directory'; -cl_object @':name'; -cl_object @':type'; -cl_object @':version'; -cl_object @':defaults'; -cl_object @':unspecific'; - -cl_object @':absolute'; -cl_object @':relative'; -cl_object @':up'; - -/******************************* ------- ******************************/ - static cl_object pathname_translations = Cnil; static void diff --git a/src/c/print.d b/src/c/print.d index ceee91cab..c43f01098 100644 --- a/src/c/print.d +++ b/src/c/print.d @@ -22,36 +22,6 @@ /******************************* EXPORTS ******************************/ -cl_object @':upcase'; -cl_object @':downcase'; -cl_object @':capitalize'; - -cl_object @':stream'; -cl_object @':escape'; -cl_object @':pretty'; -cl_object @':circle'; -cl_object @':base'; -cl_object @':radix'; -cl_object @':case'; -cl_object @':gensym'; -cl_object @':level'; -cl_object @':length'; -cl_object @':array'; - -cl_object @'*print-escape*'; -cl_object @'*print-pretty*'; -cl_object @'*print-circle*'; -cl_object @'*print-base*'; -cl_object @'*print-radix*'; -cl_object @'*print-case*'; -cl_object @'*print-gensym*'; -cl_object @'*print-level*'; -cl_object @'*print-length*'; -cl_object @'*print-array*'; - -cl_object @'si::*print-package*'; -cl_object @'si::*print-structure*'; - #ifndef THREADS bool PRINTescape; bool PRINTpretty; @@ -78,9 +48,6 @@ cl_object PRINTstream; islower((c)&0377) || (c) == ':') -cl_object @'si::pretty-print-format'; -cl_object @'si::sharp-exclamation'; - #define MARK 0400 #define UNMARK 0401 #define SET_INDENT 0402 @@ -991,7 +958,7 @@ _write_object(cl_object x, int level) break; case t_cons: - if (CAR(x) == @'si::sharp-exclamation') { + if (CAR(x) == @'si::#!') { write_str("#!"); x = CDR(x); goto BEGIN; @@ -1521,7 +1488,7 @@ potential_number_p(cl_object strng, int base) @(return obj) @) -@(defun write_char (c &optional strm) +@(defun write-char (c &optional strm) @ /* INV: char_code() checks the type of `c' */ strm = stream_or_default_output(strm); @@ -1529,7 +1496,7 @@ potential_number_p(cl_object strng, int base) @(return c) @) -@(defun write_string (strng &o strm &k (start MAKE_FIXNUM(0)) end) +@(defun write-string (strng &o strm &k (start MAKE_FIXNUM(0)) end) cl_index s, e, i; @ get_string_start_end(strng, start, end, &s, &e); @@ -1542,7 +1509,7 @@ potential_number_p(cl_object strng, int base) @(return strng) @) -@(defun write_line (strng &o strm &k (start MAKE_FIXNUM(0)) end) +@(defun write-line (strng &o strm &k (start MAKE_FIXNUM(0)) end) cl_index s, e, i; @ get_string_start_end(strng, start, end, &s, &e); @@ -1562,7 +1529,7 @@ potential_number_p(cl_object strng, int base) @(return Cnil) @) -@(defun fresh_line (&optional strm) +@(defun fresh-line (&optional strm) @ strm = stream_or_default_output(strm); if (file_column(strm) == 0) @@ -1572,21 +1539,21 @@ potential_number_p(cl_object strng, int base) @(return Ct) @) -@(defun force_output (&o strm) +@(defun force-output (&o strm) @ strm = stream_or_default_output(strm); flush_stream(strm); @(return Cnil) @) -@(defun clear_output (&o strm) +@(defun clear-output (&o strm) @ strm = stream_or_default_output(strm); clear_output_stream(strm); @(return Cnil) @) -@(defun write_byte (integer binary_output_stream) +@(defun write-byte (integer binary_output_stream) @ if (!FIXNUMP(integer)) FEerror("~S is not a byte.", 1, integer); @@ -1595,7 +1562,7 @@ potential_number_p(cl_object strng, int base) @(return integer) @) -@(defun si::write_bytes (stream string start end) +@(defun si::write-bytes (stream string start end) cl_index is, ie; FILE *fp; int written, sofarwritten, towrite; @ diff --git a/src/c/read.d b/src/c/read.d index f3762d068..52ab73d0e 100644 --- a/src/c/read.d +++ b/src/c/read.d @@ -27,13 +27,6 @@ cl_object standard_readtable; -cl_object @'*readtable*'; -cl_object @'*read_default_float_format*'; -cl_object @'*read_base*'; -cl_object @'*read_suppress*'; - -cl_object @':junk_allowed'; - #ifndef THREADS cl_object READtable; int READdefault_float_format; @@ -640,7 +633,7 @@ parse_integer(char *s, cl_index end, cl_index *ep, int radix) } static -@(defun si::left_parenthesis_reader (in c) +@(defun "left_parenthesis_reader" (in c) cl_object x, y; cl_object *p; @ @@ -720,14 +713,14 @@ read_constituent(cl_object in) } static -@(defun si::double_quote_reader (in c) +@(defun "double_quote_reader" (in c) @ read_string('"', in); @(return copy_simple_string(cl_token)) @) static -@(defun si::dispatch_reader (in dc) +@(defun "dispatch_reader_fun" (in dc) cl_object c, x, y; int i, d; @ @@ -752,27 +745,22 @@ static @) static -@(defun si::single_quote_reader (in c) +@(defun "single_quote_reader" (in c) @ @(return CONS(@'quote', CONS(read_object(in), Cnil))) @) static -@(defun si::void_reader (in c) +@(defun "void_reader" (in c) @ /* no result */ @(return) @) -#define @si::right_parenthesis_reader @si::void_reader - -/* -int -@comma-reader(){} in backq.c -*/ +#define right_parenthesis_reader void_reader static -@(defun si::semicolon_reader (in c) +@(defun "semicolon_reader" (in c) @ do c = read_char(in); @@ -781,17 +769,12 @@ static @(return) @) -/* -int -@backquote-reader(){} -*/ - /* sharpmacro routines */ static -@(defun si::sharp_C_reader (in c d) +@(defun "sharp_C_reader" (in c d) cl_object x, real, imag; @ if (d != Cnil && !READsuppress) @@ -819,7 +802,7 @@ static @) static -@(defun si::sharp_backslash_reader (in c d) +@(defun "sharp_backslash_reader" (in c d) @ if (d != Cnil && !READsuppress) if (!FIXNUMP(d) || @@ -857,7 +840,7 @@ static @) static -@(defun si::sharp_single_quote_reader (in c d) +@(defun "sharp_single_quote_reader" (in c d) @ if(d != Cnil && !READsuppress) extra_argument('#', d); @@ -879,7 +862,7 @@ static */ static -@(defun si::sharp_left_parenthesis_reader (in c d) +@(defun "sharp_left_parenthesis_reader" (in c d) bool fixed_size; cl_index dim, dimcount, i, a; cl_index sp = cl_stack_index(); @@ -902,7 +885,7 @@ static cl_stack_push(CAR(x)); goto L; } - @(return list(4, siScomma, @'apply', + @(return list(4, @'si::,', @'apply', CONS(@'quote', CONS(@'vector', Cnil)), x)) } for (dimcount = 0 ;; dimcount++) { @@ -930,7 +913,7 @@ L: @) static -@(defun si::sharp_asterisk_reader (in c d) +@(defun "sharp_asterisk_reader" (in c d) bool fixed_size; cl_index dim, dimcount, i; cl_index sp = cl_stack_index(); @@ -979,7 +962,7 @@ static @) static -@(defun si::sharp_colon_reader (in c d) +@(defun "sharp_colon_reader" (in c d) cl_index length; enum chattrib a; @ @@ -1037,7 +1020,7 @@ M: @) static -@(defun si::sharp_dot_reader (in c d) +@(defun "sharp_dot_reader" (in c d) @ if(d != Cnil && !READsuppress) extra_argument('.', d); @@ -1054,7 +1037,7 @@ static static cl_object read_VV_block = OBJNULL; static -@(defun si::sharp_exclamation_reader (in c d) +@(defun "sharp_exclamation_reader" (in c d) cl_fixnum code; @ if(d != Cnil && !READsuppress) @@ -1085,7 +1068,7 @@ static @) static -@(defun si::sharp_B_reader (in c d) +@(defun "sharp_B_reader" (in c d) cl_index i; cl_object x; @ @@ -1105,7 +1088,7 @@ static @) static -@(defun si::sharp_O_reader (in c d) +@(defun "sharp_O_reader" (in c d) cl_index i; cl_object x; @ @@ -1125,7 +1108,7 @@ static @) static -@(defun si::sharp_X_reader (in c d) +@(defun "sharp_X_reader" (in c d) cl_index i; cl_object x; @ @@ -1145,7 +1128,7 @@ static @) static -@(defun si::sharp_R_reader (in c d) +@(defun "sharp_R_reader" (in c d) int radix; cl_index i; cl_object x; @@ -1171,11 +1154,11 @@ static @(return x) @) -#define sharp_A_reader @void-reader -#define sharp_S_reader @void-reader +#define sharp_A_reader void_reader +#define sharp_S_reader void_reader static -@(defun si::sharp_eq_reader (in c d) +@(defun "sharp_eq_reader" (in c d) cl_object pair, value; @ if (READsuppress) @(return) @@ -1192,7 +1175,7 @@ static @) static -@(defun si::sharp_sharp_reader (in c d) +@(defun "sharp_sharp_reader" (in c d) cl_object pair; @ if (READsuppress) @(return) @@ -1262,14 +1245,14 @@ patch_sharp(cl_object x) return x; } -#define @si::sharp_plus_reader @si::void_reader -#define @si::sharp_minus_reader @si::void_reader -#define @si::sharp_less_than_reader @si::void_reader -#define @si::sharp_whitespace_reader @si::void_reader -#define @si::sharp_right_parenthesis_reader @si::void_reader +#define sharp_plus_reader void_reader +#define sharp_minus_reader void_reader +#define sharp_less_than_reader void_reader +#define sharp_whitespace_reader void_reader +#define sharp_right_parenthesis_reader void_reader static -@(defun si::sharp_vertical_bar_reader (in ch d) +@(defun "sharp_vertical_bar_reader" (in ch d) int c; int level = 0; @ @@ -1298,7 +1281,7 @@ static @) static -@(defun si::default_dispatch_macro (in c d) +@(defun "default_dispatch_macro_fun" (in c d) @ FEerror("Undefined dispatch macro character.", 1, c); @) @@ -1307,7 +1290,7 @@ static #P" ... " returns the pathname with namestring ... . */ static -@(defun si::sharp_P_reader (in c d) +@(defun "sharp_P_reader" (in c d) @ @(return coerce_to_pathname(read_object(in))) @) @@ -1316,7 +1299,7 @@ static #" ... " returns the pathname with namestring ... . */ static -@(defun si::sharp_double_quote_reader (in c d) +@(defun "sharp_double_quote_reader" (in c d) @ if (d != Cnil && !READsuppress) extra_argument('"', d); @@ -1329,7 +1312,7 @@ static as its content. */ static -@(defun si::sharp_dollar_reader (in c d) +@(defun "sharp_dollar_reader" (in c d) cl_object output; @ if (d != Cnil && !READsuppress) @@ -1970,7 +1953,7 @@ init_read(void) rtab[i].dispatch_table = NULL; } - dispatch_reader = make_cf(@si::dispatch_reader); + dispatch_reader = make_cf(dispatch_reader_fun); register_root(&dispatch_reader); rtab['\t'].syntax_type = cat_whitespace; @@ -1979,32 +1962,32 @@ init_read(void) rtab['\r'].syntax_type = cat_whitespace; rtab[' '].syntax_type = cat_whitespace; rtab['"'].syntax_type = cat_terminating; - rtab['"'].macro = make_cf(@si::double_quote_reader); + rtab['"'].macro = make_cf(double_quote_reader); rtab['#'].syntax_type = cat_non_terminating; rtab['#'].macro = dispatch_reader; rtab['\''].syntax_type = cat_terminating; - rtab['\''].macro = make_cf(@si::single_quote_reader); + rtab['\''].macro = make_cf(single_quote_reader); rtab['('].syntax_type = cat_terminating; - rtab['('].macro = make_cf(@si::left_parenthesis_reader); + rtab['('].macro = make_cf(left_parenthesis_reader); rtab[')'].syntax_type = cat_terminating; - rtab[')'].macro = make_cf(@si::right_parenthesis_reader); + rtab[')'].macro = make_cf(right_parenthesis_reader); /* rtab[','].syntax_type = cat_terminating; - rtab[','].macro = make_cf(@si::comma_reader); + rtab[','].macro = make_cf(comma_reader); */ rtab[';'].syntax_type = cat_terminating; - rtab[';'].macro = make_cf(@si::semicolon_reader); + rtab[';'].macro = make_cf(semicolon_reader); rtab['\\'].syntax_type = cat_single_escape; /* rtab['`'].syntax_type = cat_terminating; - rtab['`'].macro = make_cf(@si::backquote_reader); + rtab['`'].macro = make_cf(backquote_reader); */ rtab['|'].syntax_type = cat_multiple_escape; /* - rtab['|'].macro = make_cf(@si::vertical_bar_reader); + rtab['|'].macro = make_cf(vertical_bar_reader); */ - default_dispatch_macro = make_cf(@si::default_dispatch_macro); + default_dispatch_macro = make_cf(default_dispatch_macro_fun); #ifndef THREADS register_root(&default_dispatch_macro); #endif @@ -2014,43 +1997,43 @@ init_read(void) = (cl_object *)cl_alloc(RTABSIZE * sizeof(cl_object)); for (i = 0; i < RTABSIZE; i++) dtab[i] = default_dispatch_macro; - dtab['C'] = dtab['c'] = make_cf(@si::sharp_C_reader); - dtab['\\'] = make_cf(@si::sharp_backslash_reader); - dtab['\''] = make_cf(@si::sharp_single_quote_reader); - dtab['('] = make_cf(@si::sharp_left_parenthesis_reader); - dtab['*'] = make_cf(@si::sharp_asterisk_reader); - dtab[':'] = make_cf(@si::sharp_colon_reader); - dtab['.'] = make_cf(@si::sharp_dot_reader); - dtab['!'] = make_cf(@si::sharp_exclamation_reader); + dtab['C'] = dtab['c'] = make_cf(sharp_C_reader); + dtab['\\'] = make_cf(sharp_backslash_reader); + dtab['\''] = make_cf(sharp_single_quote_reader); + dtab['('] = make_cf(sharp_left_parenthesis_reader); + dtab['*'] = make_cf(sharp_asterisk_reader); + dtab[':'] = make_cf(sharp_colon_reader); + dtab['.'] = make_cf(sharp_dot_reader); + dtab['!'] = make_cf(sharp_exclamation_reader); /* Used for fasload only. */ - dtab['B'] = dtab['b'] = make_cf(@si::sharp_B_reader); - dtab['O'] = dtab['o'] = make_cf(@si::sharp_O_reader); - dtab['X'] = dtab['x'] = make_cf(@si::sharp_X_reader); - dtab['R'] = dtab['r'] = make_cf(@si::sharp_R_reader); + dtab['B'] = dtab['b'] = make_cf(sharp_B_reader); + dtab['O'] = dtab['o'] = make_cf(sharp_O_reader); + dtab['X'] = dtab['x'] = make_cf(sharp_X_reader); + dtab['R'] = dtab['r'] = make_cf(sharp_R_reader); /* - dtab['A'] = dtab['a'] = make_cf(@si::sharp_A_reader); - dtab['S'] = dtab['s'] = make_cf(@si::sharp_S_reader); + dtab['A'] = dtab['a'] = make_cf(sharp_A_reader); + dtab['S'] = dtab['s'] = make_cf(sharp_S_reader); */ dtab['A'] = dtab['a'] = make_si_ordinary("SHARP-A-READER"); dtab['S'] = dtab['s'] = make_si_ordinary("SHARP-S-READER"); - dtab['P'] = dtab['p'] = make_cf(@si::sharp_P_reader); + dtab['P'] = dtab['p'] = make_cf(sharp_P_reader); - dtab['='] = make_cf(@si::sharp_eq_reader); - dtab['#'] = make_cf(@si::sharp_sharp_reader); - dtab['+'] = make_cf(@si::sharp_plus_reader); - dtab['-'] = make_cf(@si::sharp_minus_reader); + dtab['='] = make_cf(sharp_eq_reader); + dtab['#'] = make_cf(sharp_sharp_reader); + dtab['+'] = make_cf(sharp_plus_reader); + dtab['-'] = make_cf(sharp_minus_reader); /* - dtab['<'] = make_cf(@si::sharp_less_than_reader); + dtab['<'] = make_cf(sharp_less_than_reader); */ - dtab['|'] = make_cf(@si::sharp_vertical_bar_reader); - dtab['"'] = make_cf(@si::sharp_double_quote_reader); + dtab['|'] = make_cf(sharp_vertical_bar_reader); + dtab['"'] = make_cf(sharp_double_quote_reader); /* This is specific to this implementation */ - dtab['$'] = make_cf(@si::sharp_dollar_reader); + dtab['$'] = make_cf(sharp_dollar_reader); /* This is specific to this implimentation */ /* dtab[' '] = dtab['\t'] = dtab['\n'] = dtab['\f'] - = make_cf(@si::sharp_whitespace_reader); - dtab[')'] = make_cf(@si::sharp_right_parenthesis_reader); + = make_cf(sharp_whitespace_reader); + dtab[')'] = make_cf(sharp_right_parenthesis_reader); */ init_backq(); @@ -2158,9 +2141,6 @@ read_VV(cl_object block, void *entry) } if (i < len) FEerror("Not enough data while loading binary file",0); -#ifdef PDE - bds_bind(@'si::*source-pathname*', VV[block->cblock.source_pathname]); -#endif NO_DATA: SYM_VAL(@'*package*') = old_package; (*entry_point)(MAKE_FIXNUM(0)); diff --git a/src/c/stacks.d b/src/c/stacks.d index b2061d0d8..a08f038a7 100644 --- a/src/c/stacks.d +++ b/src/c/stacks.d @@ -43,8 +43,6 @@ int NValues; cl_object Values[VSSIZE]; #endif -cl_object @':catch', @':catchall', @':protect'; - /********************* BINDING STACK ************************/ void diff --git a/src/c/string.d b/src/c/string.d index f4c53fae4..c7812c0a2 100644 --- a/src/c/string.d +++ b/src/c/string.d @@ -20,13 +20,6 @@ #include #include "ecl-inl.h" -cl_object @':start1'; -cl_object @':end1'; -cl_object @':start2'; -cl_object @':end2'; -cl_object @':start'; -cl_object @':end'; - @(defun make_string (size &key (initial_element CODE_CHAR(' ')) (element_type @'character') &aux x) diff --git a/src/c/structure.d b/src/c/structure.d index 0d14e92b7..221432a47 100644 --- a/src/c/structure.d +++ b/src/c/structure.d @@ -17,16 +17,6 @@ #include "ecl.h" -/******************************* EXPORTS ******************************/ - -cl_object @'si::structure-print-function'; -cl_object @'si::structure-slot-descriptions'; -#ifdef CLOS -cl_object @'structure-object'; -#else -cl_object siSstructure_include; -#endif - /******************************* ------- ******************************/ #ifdef CLOS @@ -51,7 +41,7 @@ structure_subtypep(cl_object x, cl_object y) return(FALSE); if (x == y) return(TRUE); - x = get(x, siSstructure_include, Cnil); + x = get(x, @'si::structure-include', Cnil); } while (x != Cnil); return(FALSE); } @@ -72,7 +62,7 @@ structure_to_list(cl_object x) int i, n; s = getf(SNAME(x)->symbol.plist, - siSstructure_slot_descriptions, Cnil); + @'si::structure-slot-descriptions', Cnil); p = &CDR(r = CONS(SNAME(x), Cnil)); for (i=0, n=SLENGTH(x); !endp(s) && isymbol.t = (short)t_symbol; + Cnil->symbol.dbind = Cnil; + Cnil->symbol.name = make_simple_string("NIL"); + Cnil->symbol.gfdef = OBJNULL; + Cnil->symbol.plist = Cnil; + Cnil->symbol.hpack = Cnil; + Cnil->symbol.stype = (short)stp_constant; + Cnil->symbol.mflag = FALSE; + Cnil->symbol.isform = FALSE; - Ct_body.t = (short)t_symbol; - Ct_body.dbind = Ct; - Ct_body.name = make_simple_string("T"); - Ct_body.gfdef = OBJNULL; - Ct_body.plist = Cnil; - Ct_body.hpack = Cnil; - Ct_body.stype = (short)stp_constant; - Ct_body.mflag = FALSE; - Ct_body.isform = FALSE; + Ct->symbol.t = (short)t_symbol; + Ct->symbol.dbind = Ct; + Ct->symbol.name = make_simple_string("T"); + Ct->symbol.gfdef = OBJNULL; + Ct->symbol.plist = Cnil; + Ct->symbol.hpack = Cnil; + Ct->symbol.stype = (short)stp_constant; + Ct->symbol.mflag = FALSE; + Ct->symbol.isform = FALSE; gensym_prefix = make_simple_string("G"); gentemp_prefix = make_simple_string("T"); diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h new file mode 100644 index 000000000..74fa3005e --- /dev/null +++ b/src/c/symbols_list.h @@ -0,0 +1,354 @@ +#define CL_ORDINARY 1 +#define CL_SPECIAL 2 +#define SI_SPECIAL 3 +#define SI_ORDINARY 4 +#define KEYWORD 5 + +#ifdef DPP +#define SW(a,b,c) a +#else +#define SW(a,b,c) {a, b, c} +#endif + +#define ECL_NUM_SYMBOLS_IN_CORE 393 + +const struct { + const char *name; +#ifndef DPP + int type; + cl_object *loc; +#endif +} all_symbols[ECL_NUM_SYMBOLS_IN_CORE + 1] = { + +SW("NIL", CL_ORDINARY, NULL), +SW("T", CL_ORDINARY, NULL), + +/* LISP PACKAGE */ +SW("&ALLOW-OTHER-KEYS", CL_ORDINARY, &clSAallow_other_keys), +SW("&AUX", CL_ORDINARY, &clSAaux), +SW("&KEY", CL_ORDINARY, &clSAkey), +SW("&OPTIONAL", CL_ORDINARY, &clSAoptional), +SW("&REST", CL_ORDINARY, &clSArest), +SW("*", CL_ORDINARY, &clV), +SW("*DEBUG-IO*", CL_SPECIAL, &clVdebug_io), +SW("*DEFAULT-PATHNAME-DEFAULTS*", CL_SPECIAL, &clVdefault_pathname_defaults), +SW("*ERROR-OUTPUT*", CL_SPECIAL, &clVerror_output), +SW("*FEATURES*", CL_SPECIAL, &clVfeatures), +SW("*GENSYM-COUNTER*", CL_SPECIAL, &clVgensym_counter), +SW("*LOAD-PRINT*", CL_SPECIAL, &clVload_print), +SW("*LOAD-VERBOSE*", CL_SPECIAL, &clVload_verbose), +SW("*MACROEXPAND-HOOK*", CL_SPECIAL, &clVmacroexpand_hook), +SW("*PACKAGE*", CL_SPECIAL, &clVpackage), +SW("*PRINT-ARRAY*", CL_SPECIAL, &clVprint_array), +SW("*PRINT-BASE*", CL_SPECIAL, &clVprint_base), +SW("*PRINT-CASE*", CL_SPECIAL, &clVprint_case), +SW("*PRINT-CIRCLE*", CL_SPECIAL, &clVprint_circle), +SW("*PRINT-ESCAPE*", CL_SPECIAL, &clVprint_escape), +SW("*PRINT-GENSYM*", CL_SPECIAL, &clVprint_gensym), +SW("*PRINT-LENGTH*", CL_SPECIAL, &clVprint_length), +SW("*PRINT-LEVEL*", CL_SPECIAL, &clVprint_level), +SW("*PRINT-PRETTY*", CL_SPECIAL, &clVprint_pretty), +SW("*PRINT-RADIX*", CL_SPECIAL, &clVprint_radix), +SW("*QUERY-IO*", CL_SPECIAL, &clVquery_io), +SW("*RANDOM-STATE*", CL_SPECIAL, &clVrandom_state), +SW("*READ-BASE*", CL_SPECIAL, &clVread_base), +SW("*READ-DEFAULT-FLOAT-FORMAT*", CL_SPECIAL, &clVread_default_float_format), +SW("*READ-SUPPRESS*", CL_SPECIAL, &clVread_suppress), +SW("*READTABLE*", CL_SPECIAL, &clVreadtable), +SW("*STANDARD-INPUT*", CL_SPECIAL, &clVstandard_input), +SW("*STANDARD-OUTPUT*", CL_SPECIAL, &clVstandard_output), +SW("*TERMINAL-IO*", CL_SPECIAL, &clVterminal_io), +SW("*TRACE-OUTPUT*", CL_SPECIAL, &clVtrace_output), +SW("AND", CL_ORDINARY, &clSand), +SW("APPEND", CL_ORDINARY, &clSappend), +SW("APPLY", CL_ORDINARY, &clSapply), +SW("ARITHMETIC-ERROR", CL_ORDINARY, &clSarithmetic_error), +SW("ARRAY", CL_ORDINARY, &clSarray), +SW("BASE-CHAR", CL_ORDINARY, &clSbase_char), +SW("BIGNUM", CL_ORDINARY, &clSbignum), +SW("BIT", CL_ORDINARY, &clSbit), +SW("BIT-VECTOR", CL_ORDINARY, &clSbit_vector), +SW("BLOCK", CL_ORDINARY, &clSblock), +SW("BROADCAST-STREAM", CL_ORDINARY, &clSbroadcast_stream), +SW("BUILT-IN-CLASS", CL_ORDINARY, &clSbuilt_in_class), +SW("BYTE8", CL_ORDINARY, &clSbyte8), +SW("CELL-ERROR", CL_ORDINARY, &clScell_error), +SW("CHARACTER", CL_ORDINARY, &clScharacter), +SW("CLASS", CL_ORDINARY, &clSclass), +SW("COMMON", CL_ORDINARY, &clScommon), +SW("COMPILE", CL_ORDINARY, &clScompile), +SW("COMPILED-FUNCTION", CL_ORDINARY, &clScompiled_function), +SW("COMPLEX", CL_ORDINARY, &clScomplex), +SW("CONCATENATED-STREAM", CL_ORDINARY, &clSconcatenated_stream), +SW("CONDITION", CL_ORDINARY, &clScondition), +SW("CONS", CL_ORDINARY, &clScons), +SW("DECLARE", CL_ORDINARY, &clSdeclare), +SW("DEFMACRO", CL_ORDINARY, NULL), +SW("DEFUN", CL_ORDINARY, NULL), +SW("DISPATCH-FUNCTION", CL_ORDINARY, &clSdispatch_function), +SW("DIVISION-BY-ZERO", CL_ORDINARY, &clSdivision_by_zero), +SW("DOUBLE-FLOAT", CL_ORDINARY, &clSdouble_float), +SW("ECHO-STREAM", CL_ORDINARY, &clSecho_stream), +SW("END-OF-FILE", CL_ORDINARY, &clSend_of_file), +SW("EQ", CL_ORDINARY, &clSeq), +SW("EQL", CL_ORDINARY, &clSeql), +SW("EQUAL", CL_ORDINARY, &clSequal), +SW("ERROR", CL_ORDINARY, &clSerror), +SW("EVAL", CL_ORDINARY, &clSeval), +SW("EXTENDED-CHAR", CL_ORDINARY, &clSextended_char), +SW("FILE-ERROR", CL_ORDINARY, &clSfile_error), +SW("FILE-STREAM", CL_ORDINARY, &clSfile_stream), +SW("FIXNUM", CL_ORDINARY, &clSfixnum), +SW("FLOAT", CL_ORDINARY, &clSfloat), +SW("FLOATING-POINT-INEXACT", CL_ORDINARY, &clSfloating_point_inexact), +SW("FLOATING-POINT-INVALID-OPERATION", CL_ORDINARY, &clSfloating_point_invalid_operation), +SW("FLOATING-POINT-OVERFLOW", CL_ORDINARY, &clSfloating_point_overflow), +SW("FLOATING-POINT-UNDERFLOW", CL_ORDINARY, &clSfloating_point_underflow), +SW("FUNCALL", CL_ORDINARY, &clSfuncall), +SW("FUNCTION", CL_ORDINARY, &clSfunction), +SW("HASH-TABLE", CL_ORDINARY, &clShash_table), +SW("INSTANCE", CL_ORDINARY, &clSinstance), +SW("INTEGER", CL_ORDINARY, &clSinteger), +SW("INTEGER8", CL_ORDINARY, &clSinteger8), +SW("KEYWORD", CL_ORDINARY, &clSkeyword), +SW("LAMBDA", CL_ORDINARY, &clSlambda), +SW("LAMBDA-BLOCK", CL_ORDINARY, &clSlambda_block), +SW("LIST", CL_ORDINARY, &clSlist), +SW("LIST*", CL_ORDINARY, &clSlistX), +SW("LOAD", CL_ORDINARY, &clSload), +SW("LOGICAL-PATHNAME", CL_ORDINARY, &clSlogical_pathname), +SW("LONG-FLOAT", CL_ORDINARY, &clSlong_float), +SW("MACRO", CL_ORDINARY, &clSmacro), +SW("MEMBER", CL_ORDINARY, &clSmember), +SW("MOD", CL_ORDINARY, &clSmod), +SW("NCONC", CL_ORDINARY, &clSnconc), +SW("NOT", CL_ORDINARY, &clSnot), +SW("NULL", CL_ORDINARY, &clSnull), +SW("NUMBER", CL_ORDINARY, &clSnumber), +SW("OR", CL_ORDINARY, &clSor), +SW("OTHERWISE", CL_ORDINARY, &clSotherwise), +SW("PACKAGE", CL_ORDINARY, &clSpackage), +SW("PACKAGE-ERROR", CL_ORDINARY, &clSpackage_error), +SW("PARSE-ERROR", CL_ORDINARY, &clSparse_error), +SW("PATHNAME", CL_ORDINARY, &clSpathname), +SW("PLUSP", CL_ORDINARY, &clSplusp), +SW("PRINT-NOT-READABLE", CL_ORDINARY, &clSprint_not_readable), +SW("PRINT-OBJECT", CL_ORDINARY, &clSprint_object), +SW("PROGN", CL_ORDINARY, &clSprogn), +SW("PROGRAM-ERROR", CL_ORDINARY, &clSprogram_error), +SW("PSETF", CL_ORDINARY, &clSpsetf), +SW("QUOTE", CL_ORDINARY, &clSquote), +SW("RANDOM-STATE", CL_ORDINARY, &clSrandom_state), +SW("RATIO", CL_ORDINARY, &clSratio), +SW("RATIONAL", CL_ORDINARY, &clSrational), +SW("READER-ERROR", CL_ORDINARY, &clSreader_error), +SW("READTABLE", CL_ORDINARY, &clSreadtable), +SW("REAL", CL_ORDINARY, &clSreal), +SW("SATISFIES", CL_ORDINARY, &clSsatisfies), +SW("SEQUENCE", CL_ORDINARY, &clSsequence), +SW("SERIOUS-CONDITION", CL_ORDINARY, &clSserious_condition), +SW("SETF", CL_ORDINARY, &clSsetf), +SW("SHORT-FLOAT", CL_ORDINARY, &clSshort_float), +SW("SIGNED-BYTE", CL_ORDINARY, &clSsigned_byte), +SW("SIGNED-CHAR", CL_ORDINARY, &clSsigned_char), +SW("SIGNED-SHORT", CL_ORDINARY, &clSsigned_short), +SW("SIMPLE-ARRAY", CL_ORDINARY, &clSsimple_array), +SW("SIMPLE-BIT-VECTOR", CL_ORDINARY, &clSsimple_bit_vector), +SW("SIMPLE-CONDITION", CL_ORDINARY, &clSsimple_condition), +SW("SIMPLE-ERROR", CL_ORDINARY, &clSsimple_error), +SW("SIMPLE-STRING", CL_ORDINARY, &clSsimple_string), +SW("SIMPLE-TYPE-ERROR", CL_ORDINARY, &clSsimple_type_error), +SW("SIMPLE-VECTOR", CL_ORDINARY, &clSsimple_vector), +SW("SIMPLE-WARNING", CL_ORDINARY, &clSsimple_warning), +SW("SINGLE-FLOAT", CL_ORDINARY, &clSsingle_float), +SW("SPECIAL", CL_ORDINARY, &clSspecial), +SW("STANDARD-CHAR", CL_ORDINARY, &clSstandard_char), +SW("STORAGE-CONDITION", CL_ORDINARY, &clSstorage_condition), +SW("STREAM", CL_ORDINARY, &clSstream), +SW("STREAM-ERROR", CL_ORDINARY, &clSstream_error), +SW("STRING", CL_ORDINARY, &clSstring), +SW("STRING-STREAM", CL_ORDINARY, &clSstring_stream), +SW("STRUCTURE", CL_ORDINARY, &clSstructure), +SW("STRUCTURE-OBJECT", CL_ORDINARY, &clSstructure_object), +SW("STYLE-WARNING", CL_ORDINARY, &clSstyle_warning), +SW("SUBTYPEP", CL_ORDINARY, &clSsubtypep), +SW("SYMBOL", CL_ORDINARY, &clSsymbol), +SW("SYNONYM-STREAM", CL_ORDINARY, &clSsynonym_stream), +SW("TAG", CL_ORDINARY, &clStag), +SW("TWO-WAY-STREAM", CL_ORDINARY, &clStwo_way_stream), +SW("TYPE-ERROR", CL_ORDINARY, &clStype_error), +SW("TYPEP", CL_ORDINARY, &clStypep), +SW("UNBOUND-SLOT", CL_ORDINARY, &clSunbound_slot), +SW("UNBOUND-VARIABLE", CL_ORDINARY, &clSunbound_variable), +SW("UNDEFINED-FUNCTION", CL_ORDINARY, &clSundefined_function), +SW("UNSIGNED-BYTE", CL_ORDINARY, &clSunsigned_byte), +SW("UNSIGNED-CHAR", CL_ORDINARY, &clSunsigned_char), +SW("UNSIGNED-SHORT", CL_ORDINARY, &clSunsigned_short), +SW("VALUES", CL_ORDINARY, &clSvalues), +SW("VECTOR", CL_ORDINARY, &clSvector), +SW("WARN", CL_ORDINARY, &clSwarn), +SW("WARNING", CL_ORDINARY, &clSwarning), + +/* SYSTEM PACKAGE */ +SW("SI::#!", SI_ORDINARY, &siSsharp_exclamation), +SW("SI::*CLASS-NAME-HASH-TABLE*", SI_SPECIAL, &siVclass_name_hash_table), +SW("SI::*GC-MESSAGE*", SI_SPECIAL, &siVgc_message), +SW("SI::*GC-VERBOSE*", SI_SPECIAL, &siVgc_verbose), +SW("SI::*IGNORE-EOF-ON-TERMINAL-IO*", SI_SPECIAL, &siVignore_eof_on_terminal_io), +SW("SI::*INDENT-FORMATTED-OUTPUT*", SI_SPECIAL, &siVindent_formatted_output), +SW("SI::*INHIBIT-MACRO-SPECIAL*", SI_SPECIAL, &siVinhibit_macro_special), +SW("SI::*INIT-FUNCTION-PREFIX*", SI_SPECIAL, &siVinit_function_prefix), +SW("SI::*KEEP-DEFINITIONS*", SI_SPECIAL, &siVkeep_definitions), +SW("SI::*LOAD-HOOKS*", SI_SPECIAL, &siVload_hooks), +SW("SI::*PRINT-PACKAGE*", SI_SPECIAL, &siVprint_package), +SW("SI::*PRINT-STRUCTURE*", SI_SPECIAL, &siVprint_structure), +SW("SI::,", SI_ORDINARY, &siScomma), +SW("SI::,.", SI_ORDINARY, &siScomma_dot), +SW("SI::,@", SI_ORDINARY, &siScomma_at), +SW("SI::CLEAR-COMPILER-PROPERTIES", SI_ORDINARY, &siSclear_compiler_properties), +SW("SI::COMPUTE-APPLICABLE-METHODS", SI_ORDINARY, &siScompute_applicable_methods), +SW("SI::COMPUTE-EFFECTIVE-METHOD", SI_ORDINARY, &siScompute_effective_method), +SW("SI::EXPAND-DEFMACRO", SI_ORDINARY, &siSexpand_defmacro), +SW("SI::GENERIC-FUNCTION-METHOD-COMBINATION", SI_ORDINARY, &siSgeneric_function_method_combination), +SW("SI::GENERIC-FUNCTION-METHOD-COMBINATION-ARGS", SI_ORDINARY, &siSgeneric_function_method_combination_args), +SW("SI::LINK-FROM", SI_ORDINARY, NULL), +SW("SI::LINK-TO", SI_ORDINARY, NULL), +SW("SI::PRETTY-PRINT-FORMAT", SI_ORDINARY, &siSpretty_print_format), +SW("SI::SETF-LAMBDA", SI_ORDINARY, &siSsetf_lambda), +SW("SI::SETF-METHOD", SI_ORDINARY, &siSsetf_method), +SW("SI::SETF-SYMBOL", SI_ORDINARY, &siSsetf_symbol), +SW("SI::SETF-UPDATE", SI_ORDINARY, &siSsetf_update), +SW("SI::SIMPLE-CONTROL-ERROR", SI_ORDINARY, &siSsimple_control_error), +SW("SI::SIMPLE-PROGRAM-ERROR", SI_ORDINARY, &siSsimple_program_error), +#ifndef CLOS +SW("SI::STRUCTURE-INCLUDE", SI_ORDINARY, &siSstructure_include), +#endif +SW("SI::STRUCTURE-PRINT-FUNCTION", SI_ORDINARY, &siSstructure_print_function), +SW("SI::STRUCTURE-SLOT-DESCRIPTIONS", SI_ORDINARY, &siSstructure_slot_descriptions), +SW("SI::SYMBOL-MACRO", SI_ORDINARY, &siSsymbol_macro), +SW("SI::TERMINAL-INTERRUPT", SI_ORDINARY, &siSterminal_interrupt), +SW("SI::UNIVERSAL-ERROR-HANDLER", SI_ORDINARY, &siSuniversal_error_handler), + +#ifdef PROFILE +SW("SI::*PROFILE-ARRAY*", SI_SPECIAL, &sSAprofile_arrayA), +#endif + +#ifdef ECL_CLOS_STREAMS +SW("STREAM-CLEAR-INPUT", CL_ORDINARY, &clSstream_clear_input), +SW("STREAM-CLEAR-OUTPUT", CL_ORDINARY, &clSstream_clear_output), +SW("STREAM-CLOSE", CL_ORDINARY, &clSstream_close), +SW("STREAM-FORCE-OUTPUT", CL_ORDINARY, &clSstream_force_output), +SW("STREAM-INPUT-P", CL_ORDINARY, &clSstream_input_p), +SW("STREAM-LISTEN", CL_ORDINARY, &clSstream_listen), +SW("STREAM-OUTPUT-P", CL_ORDINARY, &clSstream_output_p), +SW("STREAM-READ-CHAR", CL_ORDINARY, &clSstream_read_char), +SW("STREAM-UNREAD-CHAR", CL_ORDINARY, &clSstream_unread_char), +SW("STREAM-WRITE-CHAR", CL_ORDINARY, &clSstream_write_char), +#endif + +#ifdef PDE +SW("SI::*RECORD-SOURCE-PATHNAME-P*", SI_SPECIAL, &siVrecord_source_pathname_p), +SW("SI::*SOURCE-PATHNAME*", SI_SPECIAL, &siVsource_pathname), +SW("SI::RECORD-SOURCE-PATHNAME", SI_ORDINARY, &siSrecord_source_pathname), +#endif + +#ifdef THREADS +SW("CONT", CL_ORDINARY, &clScont), +SW("DEAD", CL_ORDINARY, &clSdead), +SW("RUNNING", CL_ORDINARY, &clSrunning), +SW("STOPPED", CL_ORDINARY, &clSstopped), +SW("SUSPENDED", CL_ORDINARY, &clSsuspended), +SW("THREAD", CL_ORDINARY, &clSthread), +SW("SI::THREAD-TOP-LEVEL", SI_ORDINARY, &siSthread_top_level), +SW("WAITING", CL_ORDINARY, &clSwaiting), +#endif + +/* KEYWORD PACKAGE */ +SW(":ABORT", KEYWORD, &Kabort), +SW(":ABSOLUTE", KEYWORD, &Kabsolute), +SW(":ALLOW-OTHER-KEYS", KEYWORD, &Kallow_other_keys), +SW(":APPEND", KEYWORD, &Kappend), +SW(":ARRAY", KEYWORD, &Karray), +SW(":BASE", KEYWORD, &Kbase), +SW(":BLOCK", KEYWORD, &Kblock), +SW(":CAPITALIZE", KEYWORD, &Kcapitalize), +SW(":CASE", KEYWORD, &Kcase), +SW(":CATCH", KEYWORD, &Kcatch), +SW(":CATCHALL", KEYWORD, &Kcatchall), +SW(":CIRCLE", KEYWORD, &Kcircle), +SW(":COMPILE-TOPLEVEL", KEYWORD, &Kcompile_toplevel), +SW(":CREATE", KEYWORD, &Kcreate), +SW(":DATUM", KEYWORD, &Kdatum), +SW(":DEFAULT", KEYWORD, &Kdefault), +SW(":DEFAULTS", KEYWORD, &Kdefaults), +SW(":DEVICE", KEYWORD, &Kdevice), +SW(":DIRECTION", KEYWORD, &Kdirection), +SW(":DIRECTORY", KEYWORD, &Kdirectory), +SW(":DOWNCASE", KEYWORD, &Kdowncase), +SW(":ELEMENT-TYPE", KEYWORD, &Kelement_type), +SW(":END", KEYWORD, &Kend), +SW(":END1", KEYWORD, &Kend1), +SW(":END2", KEYWORD, &Kend2), +SW(":ERROR", KEYWORD, &Kerror), +SW(":ESCAPE", KEYWORD, &Kescape), +SW(":EXECUTE", KEYWORD, &Kexecute), +SW(":EXPECTED-TYPE", KEYWORD, &Kexpected_type), +SW(":EXTERNAL", KEYWORD, &Kexternal), +SW(":FORMAT-ARGUMENTS", KEYWORD, &Kformat_arguments), +SW(":FORMAT-CONTROL", KEYWORD, &Kformat_control), +SW(":FUNCTION", KEYWORD, &Kfunction), +SW(":GENSYM", KEYWORD, &Kgensym), +SW(":HOST", KEYWORD, &Khost), +SW(":IF-DOES-NOT-EXIST", KEYWORD, &Kif_does_not_exist), +SW(":IF-EXISTS", KEYWORD, &Kif_exists), +SW(":INHERITED", KEYWORD, &Kinherited), +SW(":INITIAL-ELEMENT", KEYWORD, &Kinitial_element), +SW(":INPUT", KEYWORD, &Kinput), +SW(":INTERNAL", KEYWORD, &Kinternal), +SW(":IO", KEYWORD, &Kio), +SW(":JUNK-ALLOWED", KEYWORD, &Kjunk_allowed), +SW(":KEY", KEYWORD, &Kkey), +SW(":LENGTH", KEYWORD, &Klength), +SW(":LEVEL", KEYWORD, &Klevel), +SW(":LIST-ALL", KEYWORD, &Klist_all), +SW(":LOAD-TOPLEVEL", KEYWORD, &Kload_toplevel), +SW(":NAME", KEYWORD, &Kname), +SW(":NEW-VERSION", KEYWORD, &Knew_version), +SW(":NEWEST", KEYWORD, &Knewest), +SW(":NICKNAMES", KEYWORD, &Knicknames), +SW(":OUTPUT", KEYWORD, &Koutput), +SW(":OVERWRITE", KEYWORD, &Koverwrite), +SW(":PATHNAME", KEYWORD, &Kpathname), +SW(":PRETTY", KEYWORD, &Kpretty), +SW(":PRINT", KEYWORD, &Kprint), +SW(":PROBE", KEYWORD, &Kprobe), +SW(":PROTECT", KEYWORD, &Kprotect), +SW(":RADIX", KEYWORD, &Kradix), +SW(":REHASH-SIZE", KEYWORD, &Krehash_size), +SW(":REHASH-THRESHOLD", KEYWORD, &Krehash_threshold), +SW(":RELATIVE", KEYWORD, &Krelative), +SW(":RENAME", KEYWORD, &Krename), +SW(":RENAME-AND-DELETE", KEYWORD, &Krename_and_delete), +SW(":SET-DEFAULT-PATHNAME", KEYWORD, &Kset_default_pathname), +SW(":SIZE", KEYWORD, &Ksize), +SW(":START", KEYWORD, &Kstart), +SW(":START1", KEYWORD, &Kstart1), +SW(":START2", KEYWORD, &Kstart2), +SW(":STREAM", KEYWORD, &Kstream), +SW(":SUPERSEDE", KEYWORD, &Ksupersede), +SW(":TAG", KEYWORD, &Ktag), +SW(":TEST", KEYWORD, &Ktest), +SW(":TEST-NOT", KEYWORD, &Ktest_not), +SW(":TYPE", KEYWORD, &Ktype), +SW(":UNSPECIFIC", KEYWORD, &Kunspecific), +SW(":UP", KEYWORD, &Kup), +SW(":UPCASE", KEYWORD, &Kupcase), +SW(":USE", KEYWORD, &Kuse), +SW(":VERBOSE", KEYWORD, &Kverbose), +SW(":VERSION", KEYWORD, &Kversion), +SW(":WILD", KEYWORD, &Kwild), +SW(":WILD-INFERIORS", KEYWORD, &Kwild_inferiors), + +/* Tag for end of list */ +SW((const char*)NULL, CL_ORDINARY, NULL)}; + diff --git a/src/c/typespec.d b/src/c/typespec.d index 0b351eb3c..f0d14fa66 100644 --- a/src/c/typespec.d +++ b/src/c/typespec.d @@ -18,105 +18,6 @@ /******************************* EXPORTS ******************************/ -cl_object @'quote'; -cl_object @'lambda'; -cl_object @'special'; - -cl_object @'subtypep'; - -cl_object @'common'; -cl_object @'sequence'; - -cl_object @'null'; -cl_object @'cons'; -cl_object @'list'; -cl_object @'symbol'; - -cl_object @'array'; -cl_object @'vector'; -cl_object @'bit-vector'; -cl_object @'string'; - -cl_object @'simple-array'; -cl_object @'simple-vector'; -cl_object @'simple-string'; -cl_object @'simple-bit-vector'; - -cl_object @'pathname'; -cl_object @'character'; -cl_object @'compiled-function'; - -cl_object @'number'; -cl_object @'rational'; -cl_object @'float'; -cl_object @'real'; - -cl_object @'integer'; -cl_object @'ratio'; -cl_object @'short-float'; -cl_object @'standard-char'; - -cl_object @'fixnum'; -cl_object @'complex'; -cl_object @'single-float'; - -cl_object @'bignum'; -cl_object @'random-state'; -cl_object @'double-float'; - -cl_object @'stream'; -cl_object @'file-stream'; -cl_object @'string-stream'; -cl_object @'synonym-stream'; -cl_object @'two-way-stream'; -cl_object @'broadcast-stream'; -cl_object @'concatenated-stream'; -cl_object @'echo-stream'; - -cl_object @'bit'; -cl_object @'readtable'; -cl_object @'long-float'; -cl_object @'hash-table'; - -cl_object @'signed-char'; -cl_object @'unsigned-char'; -cl_object @'signed-short'; -cl_object @'unsigned-short'; - -cl_object @'base-char'; -cl_object @'extended-char'; -cl_object @'logical-pathname'; - -#ifdef THREADS -cl_object @'cont'; -cl_object @'thread'; -#endif - -#ifdef CLOS -cl_object @'instance'; -cl_object @'dispatch-function'; -#endif - -cl_object @'structure'; -cl_object @'satisfies'; -cl_object @'member'; -cl_object @'not'; -cl_object @'or'; -cl_object @'and'; -cl_object @'values'; -cl_object @'mod'; -cl_object @'signed-byte'; -cl_object @'unsigned-byte'; - -cl_object @'package'; - -cl_object @'*'; /* symbol * */ -cl_object @'plusp'; - -cl_object @'keyword'; - -/******************************* ------- ******************************/ - cl_object TSnon_negative_integer; cl_object TSpositive_number; diff --git a/src/c/unixfsys.d b/src/c/unixfsys.d index 157ea28f7..4dd296d64 100644 --- a/src/c/unixfsys.d +++ b/src/c/unixfsys.d @@ -35,8 +35,6 @@ # endif #endif -cl_object @':list-all'; - /* * Interprets an error code from the C library according to the POSIX * standard, and produces a suitable error message by combining the user diff --git a/src/h/external.h b/src/h/external.h index da070d10e..bbdae1ff4 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -38,11 +38,8 @@ extern void init_alloc(void); extern void init_all_functions(void); -/* all_keywords.c */ -extern void init_all_keywords(void); - - /* all_symbols */ +extern struct symbol cl_symbols[]; extern void init_all_symbols(void); diff --git a/src/h/object.h b/src/h/object.h index f13e57642..942c3a8be 100644 --- a/src/h/object.h +++ b/src/h/object.h @@ -136,8 +136,8 @@ enum stype { /* symbol type */ stp_special /* special */ }; -#define Cnil ((cl_object)&Cnil_body) -#define Ct ((cl_object)&Ct_body) +#define Cnil ((cl_object)cl_symbols) +#define Ct ((cl_object)(cl_symbols+1)) struct symbol { HEADER3(stype, mflag, isform); @@ -156,8 +156,6 @@ struct symbol { #define SYM_VAL(sym) ((sym)->symbol.dbind) #define SYM_FUN(sym) ((sym)->symbol.gfdef) -extern struct symbol Cnil_body, Ct_body; - struct package { HEADER1(locked); cl_object name; /* package name, a string */ diff --git a/src/h/page.h b/src/h/page.h index 9bf546f5b..6da7c3aad 100644 --- a/src/h/page.h +++ b/src/h/page.h @@ -129,31 +129,6 @@ extern char *data_end; /* core end */ * SYMBOLS & KEYWORDS DATABASE * *******************************/ - - -struct symbol_info { - cl_object * const loc; - const char *name; - int type; -}; - -extern const struct symbol_info all_symbols[]; - -struct keyword_info { - cl_object * const loc; - const char *name; -}; - -extern const struct keyword_info all_keywords[]; - -struct function_info { - const char *name; - cl_object (*f)(int, ...); - short type; -}; - -extern const struct function_info all_functions[]; - #ifdef __cplusplus } #endif