Menu
▾
▴
clisp-cvs Digest, Vol 22, Issue 16
|
From: <cli...@li...> - 2008-02-15 01:50:42
|
Send clisp-cvs mailing list submissions to cli...@li... To subscribe or unsubscribe via the World Wide Web, visit https://lists.sourceforge.net/lists/listinfo/clisp-cvs or, via email, send a message with subject or body 'help' to cli...@li... You can reach the person managing the list at cli...@li... When replying, please edit your Subject line so it is more specific than "Re: Contents of clisp-cvs digest..." CLISP CVS commits for today Today's Topics: 1. clisp/doc impext.xml,1.494,1.495 impent.xml,1.300,1.301 (Sam Steingold) 2. clisp/src subr.d, 1.246, 1.247 record.d, 1.126, 1.127 macros2.lisp, 1.37, 1.38 foreign1.lisp, 1.117, 1.118 foreign.d, 1.175, 1.176 eval.d, 1.243, 1.244 constsym.d, 1.358, 1.359 constobj.d, 1.190, 1.191 NEWS, 1.422, 1.423 ChangeLog, 1.5989, 1.5990 (Sam Steingold) 3. clisp/src subrkw.d, 1.59, 1.60 subr.d, 1.247, 1.248 record.d, 1.127, 1.128 io.d, 1.333, 1.334 eval.d, 1.244, 1.245 constsym.d, 1.359, 1.360 compiler.lisp, 1.308, 1.309 (Sam Steingold) ---------------------------------------------------------------------- Message: 1 Date: Thu, 14 Feb 2008 23:09:51 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/doc impext.xml,1.494,1.495 impent.xml,1.300,1.301 To: cli...@li... Message-ID: <E1J...@ma...> Update of /cvsroot/clisp/clisp/doc In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv10540/doc Modified Files: impext.xml impent.xml Log Message: (version): bump because of JITC; remove legacy ABI Index: impext.xml =================================================================== RCS file: /cvsroot/clisp/clisp/doc/impext.xml,v retrieving revision 1.494 retrieving revision 1.495 diff -u -d -r1.494 -r1.495 --- impext.xml 12 Feb 2008 16:37:59 -0000 1.494 +++ impext.xml 14 Feb 2008 23:09:49 -0000 1.495 @@ -2788,12 +2788,23 @@ <listitem><simpara>See <xref linkend="c-flavor"/>. </simpara></listitem></varlistentry></variablelist></listitem></varlistentry> +<varlistentry id="dffi-open-lib"><term><code>(&open-foreign-library; + &name-r;)</code></term> + <listitem><simpara>Open (load) a shared foreign library.</simpara> + <simpara>This is only needed if you want to test + for <emphasis>presence</emphasis> of a library without creating a + foreign object. When you create a &foreign-variable-t; or a + &foreign-function-t; using &def-c-var; or &def-call-out; with a + &library-k; argument, the library &name-r; is opened automatically. +</simpara></listitem></varlistentry> + <varlistentry id="dffi-close-lib"><term><code>(&close-foreign-library; &name-r;)</code></term> - <listitem><simpara>Close (unload) a shared foreign library (opened by the - &library-k; argument to &def-call-out; or &def-c-var;).</simpara> + <listitem><simpara>Close (unload) a shared foreign library (opened by + &open-foreign-library; or the &library-k; argument to &def-call-out; + or &def-c-var;).</simpara> <simpara>If you modify your shared library, you need to use close it - using &close-foreign-library; first. When you try to use the + using &close-foreign-library; first. When you use the &foreign-variable-t; or the &foreign-function-t; which resides in the library &name-r;, it will be re-opened automatically. </simpara></listitem></varlistentry> Index: impent.xml =================================================================== RCS file: /cvsroot/clisp/clisp/doc/impent.xml,v retrieving revision 1.300 retrieving revision 1.301 diff -u -d -r1.300 -r1.301 --- impent.xml 12 Feb 2008 17:27:43 -0000 1.300 +++ impent.xml 14 Feb 2008 23:09:49 -0000 1.301 @@ -576,6 +576,7 @@ <!ENTITY foreign-variable '<link linkend="dffi-make-var"><function>FFI:FOREIGN-VARIABLE</function></link>'> <!ENTITY foreign-variable-t '<link linkend="dffi-variables"><classname>FFI:FOREIGN-VARIABLE</classname></link>'> <!ENTITY close-foreign-library '<link linkend="dffi-close-lib"><function>FFI:CLOSE-FOREIGN-LIBRARY</function></link>'> +<!ENTITY open-foreign-library '<link linkend="dffi-open-lib"><function>FFI:OPEN-FOREIGN-LIBRARY</function></link>'> <!ENTITY default-foreign-library '<link linkend="dffi-default-lib"><function>FFI:DEFAULT-FOREIGN-LIBRARY</function></link>'> <!ENTITY linkset '<olink targetdoc="impnotes" targetptr="linkset">linking set</olink>'> <!ENTITY link-sh '<olink targetdoc="impnotes" targetptr="modset"><command>link.sh</command></olink>'> ------------------------------ Message: 2 Date: Thu, 14 Feb 2008 23:09:51 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src subr.d, 1.246, 1.247 record.d, 1.126, 1.127 macros2.lisp, 1.37, 1.38 foreign1.lisp, 1.117, 1.118 foreign.d, 1.175, 1.176 eval.d, 1.243, 1.244 constsym.d, 1.358, 1.359 constobj.d, 1.190, 1.191 NEWS, 1.422, 1.423 ChangeLog, 1.5989, 1.5990 To: cli...@li... Message-ID: <E1J...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv10540/src Modified Files: subr.d record.d macros2.lisp foreign1.lisp foreign.d eval.d constsym.d constobj.d NEWS ChangeLog Log Message: (version): bump because of JITC; remove legacy ABI Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.5989 retrieving revision 1.5990 diff -u -d -r1.5989 -r1.5990 --- ChangeLog 13 Feb 2008 23:40:57 -0000 1.5989 +++ ChangeLog 14 Feb 2008 23:09:46 -0000 1.5990 @@ -1,3 +1,21 @@ +2008-02-14 Sam Steingold <sd...@gn...> + + * constobj.d (version): bump + * constsym.d, subr.d, foreign.d (lookup_foreign_variable) + (lookup_foreign_function, foreign_library_variable): remove legacy ABI + * constsym.d, subr.d, foreign.d (open_foreign_library): renamed + from foreign_library + * foreign.d (open_library, update_library, check_library): + remove legacy version argument + * eval.d (FUNTAB): add cs_string_eq, cs_string_noteq, cs_string_less, + cs_string_greater, cs_string_ltequal, cs_string_gtequal, cs_string, + fdefinition, whitespacep, elastic_newline, cs_intern, cs_find_symbol, + cs_shadow, cs_make_package, cs_find_all_symbols, cs_symbol_name, + map_into, xgcd + * foreign1.lisp (open-foreign-library): export + * macros2.lisp (check-not-special-variable-p): remove legacy ABI + * record.d, subr.d (MAKE-MACRO): both arguments are required + 2008-02-13 Sam Steingold <sd...@gn...> first stab at keeping JITC code in the closure Index: subr.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/subr.d,v retrieving revision 1.246 retrieving revision 1.247 diff -u -d -r1.246 -r1.247 --- subr.d 7 Feb 2008 17:44:44 -0000 1.246 +++ subr.d 14 Feb 2008 23:09:45 -0000 1.247 @@ -966,7 +966,7 @@ LISPFUNN(symbol_macro_expand,1) LISPFUN(make_global_symbol_macro,seclass_no_se,1,0,norest,nokey,0,NIL) LISPFUNN(global_symbol_macro_definition,1) -LISPFUN(make_macro,seclass_no_se,1,1,norest,nokey,0,NIL) +LISPFUN(make_macro,seclass_no_se,2,0,norest,nokey,0,NIL) LISPFUNN(macrop,1) LISPFUNN(macro_expander,1) LISPFUNN(macro_lambda_list,1) @@ -1392,7 +1392,6 @@ LISPFUN(foreign_function,seclass_read,2,0,norest,key,1,(kw(name)) ) LISPFUNN(sizeof,1) LISPFUNN(bitsizeof,1) -LISPFUNN(lookup_foreign_variable,2) LISPFUNN(find_foreign_variable,4) LISPFUN(foreign_variable,seclass_read,2,0,norest,key,1,(kw(name)) ) LISPFUNN(foreign_value,1) @@ -1410,14 +1409,11 @@ LISPFUN(foreign_allocate,seclass_default,1,0,norest,key,3, (kw(initial_contents),kw(count),kw(read_only))) LISPFUN(foreign_free,seclass_default,1,0,norest,key,1,(kw(full))) -LISPFUNN(lookup_foreign_function,3) LISPFUNN(find_foreign_function,5) LISPFUN(foreign_call_out,seclass_default,1,0,rest,nokey,0,NIL) #if defined(WIN32_NATIVE) || defined(HAVE_DLOPEN) -LISPFUN(foreign_library,seclass_default,1,1,norest,nokey,0,NIL) +LISPFUNN(open_foreign_library,1) LISPFUNN(close_foreign_library,1) -LISPFUNN(foreign_library_variable,4) -LISPFUNN(foreign_library_function,5) #endif /* WIN32_NATIVE || HAVE_DLOPEN */ #endif /* DYNAMIC_FFI */ /* ---------- ZTHREAD ---------- */ Index: constsym.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/constsym.d,v retrieving revision 1.358 retrieving revision 1.359 diff -u -d -r1.358 -r1.359 --- constsym.d 7 Feb 2008 17:44:45 -0000 1.358 +++ constsym.d 14 Feb 2008 23:09:46 -0000 1.359 @@ -1161,7 +1161,6 @@ LISPSYM(set_foreign_pointer,"SET-FOREIGN-POINTER",ffi) LISPSYM(sizeof,"%SIZEOF",ffi) /* ABI */ LISPSYM(bitsizeof,"%BITSIZEOF",ffi) /* ABI */ -LISPSYM(lookup_foreign_variable,"LOOKUP-FOREIGN-VARIABLE",ffi) /* Legacy ABI */ LISPSYM(find_foreign_variable,"FIND-FOREIGN-VARIABLE",ffi) /* ABI */ LISPSYM(unsigned_foreign_address,"UNSIGNED-FOREIGN-ADDRESS",ffi) LISPSYM(foreign_address_unsigned,"FOREIGN-ADDRESS-UNSIGNED",ffi) @@ -1179,14 +1178,11 @@ LISPSYM(call_with_foreign_string,"CALL-WITH-FOREIGN-STRING",ffi) LISPSYM(foreign_allocate,"FOREIGN-ALLOCATE",ffi) LISPSYM(foreign_free,"FOREIGN-FREE",ffi) -LISPSYM(lookup_foreign_function,"LOOKUP-FOREIGN-FUNCTION",ffi) /* Legacy ABI */ LISPSYM(find_foreign_function,"FIND-FOREIGN-FUNCTION",ffi) /* ABI */ LISPSYM(foreign_call_out,"FOREIGN-CALL-OUT",ffi) #if defined(WIN32_NATIVE) || defined(HAVE_DLOPEN) -LISPSYM(foreign_library,"FOREIGN-LIBRARY",ffi) /* Legacy ABI */ +LISPSYM(open_foreign_library,"OPEN-FOREIGN-LIBRARY",ffi) LISPSYM(close_foreign_library,"CLOSE-FOREIGN-LIBRARY",ffi) -LISPSYM(foreign_library_variable,"FOREIGN-LIBRARY-VARIABLE",ffi) /* Legacy ABI */ -LISPSYM(foreign_library_function,"FOREIGN-LIBRARY-FUNCTION",ffi) /* Legacy ABI */ #endif /* WIN32_NATIVE || HAVE_DLOPEN */ #endif /* DYNAMIC_FFI */ /* ---------- ZTHREAD ---------- */ Index: record.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/record.d,v retrieving revision 1.126 retrieving revision 1.127 diff -u -d -r1.126 -r1.127 --- record.d 13 Feb 2008 23:40:56 -0000 1.126 +++ record.d 14 Feb 2008 23:09:45 -0000 1.127 @@ -770,9 +770,9 @@ (SYS::MACROP object) tests for a Macro. (SYS::MACRO-EXPANDER macro) returns the macro's expander function. */ -/* (SYS::MAKE-MACRO expander &optional lambdalist) [&optional is Legacy ABI] +/* (SYS::MAKE-MACRO expander lambdalist) returns a Macro object with the given expander function. */ -LISPFUN(make_macro,seclass_no_se,1,1,norest,nokey,0,NIL) { +LISPFUN(make_macro,seclass_no_se,2,0,norest,nokey,0,NIL) { STACK_1 = check_function(STACK_1); var object m = allocate_macro(); TheMacro(m)->macro_lambda_list = popSTACK(); Index: foreign.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/foreign.d,v retrieving revision 1.175 retrieving revision 1.176 diff -u -d -r1.175 -r1.176 --- foreign.d 22 Jan 2008 22:07:27 -0000 1.175 +++ foreign.d 14 Feb 2008 23:09:45 -0000 1.176 @@ -2437,8 +2437,8 @@ pushSTACK(NIL); /* 4 continue-format-string */ pushSTACK(S(error)); /* 3 error type */ pushSTACK(NIL); /* 2 error-format-string */ - pushSTACK(S(lookup_foreign_variable)); /* 1 */ - pushSTACK(*name); /* 0 */ + pushSTACK(S(find_foreign_variable)); /* 1 */ + pushSTACK(*name); /* 0 */ STACK_2 = CLSTEXT("~S: foreign variable ~S does not exist"); STACK_4 = CLSTEXT("Skip foreign variable creation"); funcall(L(cerror_of_type),5); @@ -2483,13 +2483,6 @@ return fvar; } -/* (FFI::LOOKUP-FOREIGN-VARIABLE foreign-variable-name foreign-type) - LEGACY */ -LISPFUNN(lookup_foreign_variable,2) { - STACK_1 = coerce_ss(STACK_1); - VALUES1(lookup_foreign_variable(&STACK_1,&STACK_0)); - skipSTACK(2); -} - /* forvard declaration -- defined later */ static maygc object foreign_library_variable (gcv_object_t *name, gcv_object_t* fvd, @@ -3227,15 +3220,6 @@ return ffun; } -/* (FFI::LOOKUP-FOREIGN-FUNCTION foreign-function-name foreign-type properties) - LEGACY */ -LISPFUNN(lookup_foreign_function,3) { - STACK_2 = coerce_ss(STACK_2); - STACK_1 = check_foreign_function_type(STACK_1); - VALUES1(lookup_foreign_function(&STACK_2,&STACK_1,&STACK_0)); - skipSTACK(3); -} - /* forvard declaration -- defined later */ local maygc object foreign_library_function (gcv_object_t* name, gcv_object_t* fvd, gcv_object_t* properties, @@ -4177,12 +4161,11 @@ } #endif -/* Open a library with the given name and version +/* Open a library with the given name name: pointer to a Lisp string (corrected on error) or :DEFAULT or :NEXT - version: library version, not used (a holdover from Amiga?) returns a dlopen() handle to the DLL can trigger GC -- only on error */ -local maygc void * open_library (gcv_object_t* name, uintL version) +local maygc void * open_library (gcv_object_t* name) { var void * handle; open_library_restart: @@ -4271,12 +4254,11 @@ /* update the DLL pointer and all related objects: re-open the library, and update the base fp_pointer of fpointer-library-handle and all objects in acons = (library-name fpointer-library-handle object1 object2 ...) - version = library version, not used (a holdover from Amiga?) can trigger GC -- only on error in open_library() or object_handle() */ -local maygc void update_library (object acons, uintL version) { +local maygc void update_library (object acons) { pushSTACK(acons); var gcv_object_t *acons_ = &STACK_0; - var void *lib_handle = open_library(&Car(*acons_),version); + var void *lib_handle = open_library(&Car(*acons_)); pushSTACK(Car(Cdr(*acons_))); /* library address - Fpointer */ var gcv_object_t *lib_addr_ = &STACK_0; /* presumably invalid */ TheFpointer(*lib_addr_)->fp_pointer = lib_handle; @@ -4336,11 +4318,10 @@ /* Check a foreign library argument: an address or a string > obj ----- library name (will be opened) or address (will be updated) - > version - missing or integer (legacy, not used) < Return the library specifier (name fpointer object...) if obj was the name, it is checked and updated by open_library can trigger GC */ -local maygc object check_library (gcv_object_t *obj, uintL version) { +local maygc object check_library (gcv_object_t *obj) { var object lib_spec = (fpointerp(*obj) ? find_library_by_address(*obj) : stringp(*obj) ? find_library_by_name(*obj) : NIL); if (nullp(lib_spec)) { /* open new */ @@ -4348,7 +4329,7 @@ pushSTACK(allocate_cons()); pushSTACK(allocate_cons()); pushSTACK(allocate_cons()); pushSTACK(allocate_fpointer((void*)0)); /* Open the library: */ - var void * libaddr = open_library(obj,version); + var void * libaddr = open_library(obj); var object lib = popSTACK(); var object acons = popSTACK(); var object new_cons = popSTACK(); @@ -4364,20 +4345,19 @@ if (!fp_validp(TheFpointer(Car(Cdr(lib_spec))))) /* Library already existed in a previous Lisp session. Update the address, and make it valid. */ - update_library(lib_spec,version); + update_library(lib_spec); return lib_spec; } } -/* (FFI::FOREIGN-LIBRARY name [required-version]) +/* (FFI:OPEN-FOREIGN-LIBRARY name) returns a foreign library specifier (fpointer). */ -LISPFUN(foreign_library,seclass_default,1,1,norest,nokey,0,NIL) { - var uintL v = (boundp(STACK_0) ? I_to_uint32(check_uint32(STACK_0)) : 0); - VALUES1(Car(Cdr(check_library(&STACK_1,v)))); - skipSTACK(2); +LISPFUNN(open_foreign_library,1) { + VALUES1(Car(Cdr(check_library(&STACK_0)))); + skipSTACK(1); } -/* (FFI:CLOSE-FOREIGN-LIBRARY name [required-version]) */ +/* (FFI:CLOSE-FOREIGN-LIBRARY name) */ LISPFUNN(close_foreign_library,1) { var object lib_cons = find_library_by_name(popSTACK()); if (consp(lib_cons)) { @@ -4401,7 +4381,7 @@ while (consp(STACK_0)) { var object acons = Car(STACK_0); STACK_0 = Cdr(STACK_0); if (eq(Car(Cdr(acons)),STACK_1)) { - update_library(acons,0); /*version??*/ + update_library(acons); skipSTACK(2); return; } } @@ -4448,7 +4428,7 @@ can trigger GC */ local maygc object foreign_library_check (gcv_object_t *name, gcv_object_t *library, gcv_object_t *offset) { - *library = check_library(library,0); + *library = check_library(library); if (!nullp(*offset)) *offset = check_sint32(*offset); return object_address(*library,*name,*offset); } @@ -4487,13 +4467,6 @@ return popSTACK(); /* fvar */ } -/* (FFI::FOREIGN-LIBRARY-VARIABLE name library offset c-type) LEGACY */ -LISPFUNN(foreign_library_variable,4) { - STACK_3 = coerce_ss(STACK_3); - VALUES1(foreign_library_variable(&STACK_3,&STACK_0,&STACK_2,&STACK_1)); - skipSTACK(4); -} - /* UP: find and allocate a foreign function in a dynamic library > name - function C name (string - prechecked) > library - library C name (string - checked here) @@ -4517,15 +4490,6 @@ return popSTACK(); /* ffun */ } -/* (FFI::FOREIGN-LIBRARY-FUNCTION name library properties offset - c-function-type) LEGACY. */ -LISPFUNN(foreign_library_function,5) { - STACK_4 = coerce_ss(STACK_4); - VALUES1(foreign_library_function(&STACK_4,&STACK_0,&STACK_2, - &STACK_3,&STACK_1)); - skipSTACK(5); -} - #else /* not WIN32_NATIVE HAVE_DLOPEN */ /* Try to make a Foreign-Pointer valid again. Index: foreign1.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/foreign1.lisp,v retrieving revision 1.117 retrieving revision 1.118 diff -u -d -r1.117 -r1.118 --- foreign1.lisp 14 Feb 2008 18:58:49 -0000 1.117 +++ foreign1.lisp 14 Feb 2008 23:09:45 -0000 1.118 @@ -27,7 +27,7 @@ with-foreign-object with-c-var with-foreign-string foreign-allocate allocate-deep allocate-shallow foreign-free foreign-pointer set-foreign-pointer - close-foreign-library memory-as + open-foreign-library close-foreign-library memory-as foreign-variable foreign-function)) (eval-when (load compile eval) Index: macros2.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/macros2.lisp,v retrieving revision 1.37 retrieving revision 1.38 diff -u -d -r1.37 -r1.38 --- macros2.lisp 5 Jun 2007 14:52:18 -0000 1.37 +++ macros2.lisp 14 Feb 2008 23:09:45 -0000 1.38 @@ -226,7 +226,6 @@ (SYSTEM::%PUT ',symbol 'SYSTEM::SYMBOLMACRO (SYSTEM::MAKE-GLOBAL-SYMBOL-MACRO ',expansion))) ',symbol)) -(defun check-not-special-variable-p (symbol)) ; legacy ABI ;; ---------------------------------------------------------------------------- ;; X3J13 vote <123> ;; Macro (nth-value n form) == (nth n (multiple-value-list form)), CLtL2 S. 184 Index: NEWS =================================================================== RCS file: /cvsroot/clisp/clisp/src/NEWS,v retrieving revision 1.422 retrieving revision 1.423 diff -u -d -r1.422 -r1.423 --- NEWS 11 Feb 2008 16:05:10 -0000 1.422 +++ NEWS 14 Feb 2008 23:09:46 -0000 1.423 @@ -1,3 +1,12 @@ +Important notes +--------------- + +* All .fas files generated by previous CLISP versions are invalid and + must be recompiled. This is because the Just-In-Time Compiled code is + kept with the closures. + Set CUSTOM:*LOAD-OBSOLETE-ACTION* to :COMPILE to automate this. + See <http://clisp.cons.org/impnotes/system-dict.html#loadfile> for details. + User visible changes -------------------- Index: constobj.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/constobj.d,v retrieving revision 1.190 retrieving revision 1.191 diff -u -d -r1.190 -r1.191 --- constobj.d 13 Jan 2008 02:47:19 -0000 1.190 +++ constobj.d 14 Feb 2008 23:09:46 -0000 1.191 @@ -332,7 +332,7 @@ /* The date of the last change of the bytecode interpreter or the arglist of any built-in function in FUNTAB */ /* when changing, remove legacy ABI */ - LISPOBJ(version,"(20060802)") + LISPOBJ(version,"(20080214)") #ifdef MACHINE_KNOWN LISPOBJ(machine_type_string,"NIL") LISPOBJ(machine_version_string,"NIL") Index: eval.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/eval.d,v retrieving revision 1.243 retrieving revision 1.244 diff -u -d -r1.243 -r1.244 --- eval.d 13 Feb 2008 23:40:57 -0000 1.243 +++ eval.d 14 Feb 2008 23:09:45 -0000 1.244 @@ -26,23 +26,25 @@ _(bit_orc2), _(bit_not), _(array_has_fill_pointer_p), _(fill_pointer), _(set_fill_pointer), _(vector_push), _(vector_pop), _(vector_push_extend), _(make_array), _(adjust_array), - /* CHARSTRG : 47 SUBRs */ + /* CHARSTRG : 54 SUBRs */ _(standard_char_p), _(graphic_char_p), _(string_char_p), _(alpha_char_p), _(upper_case_p), _(lower_case_p), _(both_case_p), _(digit_char_p), _(alphanumericp), _(char_code), _(code_char), _(character), _(char_upcase), _(char_downcase), _(digit_char), _(char_int), _(int_char), _(char_name), - _(char), _(schar), _(store_char), _(store_schar), _(string_eq), - _(string_noteq), _(string_less), _(string_greater), - _(string_ltequal), _(string_gtequal), _(string_equal), + _(char), _(schar), _(store_char), _(store_schar), + _(string_eq), _(cs_string_eq), _(string_noteq), _(cs_string_noteq), + _(string_less), _(cs_string_less), _(string_greater), _(cs_string_greater), + _(string_ltequal), _(cs_string_ltequal), + _(string_gtequal), _(cs_string_gtequal), _(string_equal), _(string_not_equal), _(string_lessp), _(string_greaterp), _(string_not_greaterp), _(string_not_lessp), _(search_string_eq), _(search_string_equal), _(make_string), _(string_both_trim), _(nstring_upcase), _(string_upcase), _(nstring_downcase), _(string_downcase), _(nstring_capitalize), _(string_capitalize), - _(string), _(name_char), _(substring), - /* CONTROL : 23-2 SUBRs */ - _(symbol_value), /* _(symbol_function), */ _(boundp), _(fboundp), - _(special_operator_p), _(set), _(makunbound), _(fmakunbound), + _(string), _(cs_string), _(name_char), _(substring), + /* CONTROL : 24-2 SUBRs */ + _(symbol_value), /* _(symbol_function), */ _(fdefinition), _(boundp), + _(fboundp), _(special_operator_p), _(set), _(makunbound), _(fmakunbound), /* _(values_list), */ _(driver), _(unwind_to_driver), _(macro_function), _(macroexpand), _(macroexpand_1), _(proclaim), _(eval), _(evalhook), _(applyhook), _(constantp), _(function_side_effect), @@ -54,16 +56,16 @@ _(make_hash_table), _(gethash), _(puthash), _(remhash), _(maphash), _(clrhash), _(hash_table_count), _(hash_table_iterator), _(hash_table_iterate), _(class_gethash), _(sxhash), - /* IO : 36 SUBRs */ + /* IO : 38 SUBRs */ _(copy_readtable), _(set_syntax_from_char), _(set_macro_character), _(get_macro_character), _(make_dispatch_macro_character), _(set_dispatch_macro_character), _(get_dispatch_macro_character), _(read), _(read_preserving_whitespace), _(read_delimited_list), _(read_line), _(read_char), _(unread_char), _(peek_char), _(listen), - _(read_char_no_hang), _(clear_input), _(read_from_string), - _(parse_integer), _(write), _(prin1), _(print), _(pprint), _(princ), + _(read_char_no_hang), _(clear_input), _(read_from_string), _(parse_integer), + _(whitespacep), _(write), _(prin1), _(print), _(pprint), _(princ), _(write_to_string), _(prin1_to_string), _(princ_to_string), _(write_char), - _(write_string), _(write_line), _(terpri), _(fresh_line), + _(write_string), _(write_line), _(terpri), _(fresh_line), _(elastic_newline), _(finish_output), _(force_output), _(clear_output), _(line_position), /* LIST : 84-36=48 SUBRs */ /* _(car), _(cdr), _(caar), _(cadr), _(cdar), _(cddr), _(caaar), _(caadr), @@ -84,13 +86,15 @@ _(lisp_implementation_type), _(lisp_implementation_version), _(software_type), _(software_version), _(identity), _(get_universal_time), _(get_internal_run_time), _(get_internal_real_time), _(sleep), _(time), - /* PACKAGE : 26 SUBRs */ + /* PACKAGE : 31 SUBRs */ _(make_symbol), _(find_package), _(package_name), _(package_nicknames), _(rename_package), _(package_use_list), _(package_used_by_list), - _(package_shadowing_symbols), _(list_all_packages), _(intern), - _(find_symbol), _(unintern), _(export), _(unexport), _(import), - _(shadowing_import), _(shadow), _(use_package), _(unuse_package), - _(make_package), _(pin_package), _(find_all_symbols), + _(package_shadowing_symbols), _(list_all_packages), _(intern), _(cs_intern), + _(find_symbol), _(cs_find_symbol), _(unintern), _(export), _(unexport), + _(import), _(shadowing_import), _(shadow), _(cs_shadow), + _(use_package), _(unuse_package), + _(make_package), _(cs_make_package), _(pin_package), + _(find_all_symbols), _(cs_find_all_symbols), _(map_symbols), _(map_external_symbols), _(map_all_symbols), _(pfind_package), _(re_export), /* PATHNAME : 27 SUBRs */ @@ -142,10 +146,10 @@ _(output_stream_p), _(built_in_stream_element_type), _(stream_external_format), _(built_in_stream_close), _(read_byte), _(write_byte), _(file_position), _(file_length), - /* SYMBOL : 14 SUBRs */ + /* SYMBOL : 15 SUBRs */ _(putd), _(proclaim_constant), _(get), _(getf), _(get_properties), _(putplist), _(put), _(remprop), _(symbol_package), _(symbol_plist), - _(symbol_name), _(keywordp), _(gensym), _(gensym), + _(symbol_name), _(cs_symbol_name), _(keywordp), _(gensym), _(gensym), /* LISPARIT : 84 SUBRs */ _(decimal_string), _(zerop), _(plusp), _(minusp), _(oddp), _(evenp), _(plus_one), _(minus_one), _(conjugate), _(exp), _(expt), _(log), @@ -163,7 +167,9 @@ _(make_random_state), _(factorial), _(exquo), _(long_float_digits), _(set_long_float_digits), _(log2), _(log10), /* other: */ -}; /* that were 529-43 SUBRs. */ +}; /* that were 501 = 542 - 41 SUBRs. + (- (+ 0 3 30 54 24 0 11 38 84 10 31 27 44 23 40 24 15 84) + (+ 0 0 2 0 0 0 0 0 36 0 0 0 3 0 0 0 0 0)) */ /* Now FUNTABR : */ local const Subr FUNTABR[] = { /* SPVW : 0 SUBRs */ @@ -193,16 +199,17 @@ /* PREDTYPE : 0 SUBRs */ /* RECORD : 1 SUBR */ _(pallocate_instance), - /* SEQUENCE : 6 SUBRs */ - _(concatenate), _(map), _(some), _(every), _(notany), _(notevery), + /* SEQUENCE : 7 SUBRs */ + _(concatenate), _(map), _(map_into), _(some), _(every), _(notany), + _(notevery), /* STREAM : 2 SUBRs */ _(make_broadcast_stream), _(make_concatenated_stream), /* SYMBOL : 0 SUBRs */ - /* LISPARIT : 18 SUBRs */ + /* LISPARIT : 19 SUBRs */ _(numequal), _(numunequal), _(smaller), _(greater), _(ltequal), _(gtequal), _(max), _(min), _(plus), _(minus), _(star), _(slash), _(gcd), - _(lcm), _(logior), _(logxor), _(logand), _(logeqv), -}; /* That were 63 SUBRs. */ + _(xgcd), _(lcm), _(logior), _(logxor), _(logand), _(logeqv) +}; /* That were (+ 0 0 7 13 9 0 2 1 0 4 0 0 0 0 1 7 2 0 19) = 65 SUBRs. */ #undef _ #define FUNTAB1 (&FUNTAB[0]) #define FUNTAB2 (&FUNTAB[256]) ------------------------------ Message: 3 Date: Fri, 15 Feb 2008 01:50:14 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src subrkw.d, 1.59, 1.60 subr.d, 1.247, 1.248 record.d, 1.127, 1.128 io.d, 1.333, 1.334 eval.d, 1.244, 1.245 constsym.d, 1.359, 1.360 compiler.lisp, 1.308, 1.309 To: cli...@li... Message-ID: <E1J...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv5708/src Modified Files: subrkw.d subr.d record.d io.d eval.d constsym.d compiler.lisp Log Message: merge record.d:make-code-vector and compiler.lisp:make-closure into record:make-closure Index: compiler.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/compiler.lisp,v retrieving revision 1.308 retrieving revision 1.309 diff -u -d -r1.308 -r1.309 --- compiler.lisp 13 Feb 2008 23:40:57 -0000 1.308 +++ compiler.lisp 15 Feb 2008 01:50:11 -0000 1.309 @@ -204,17 +204,6 @@ further constants) |# -;; FIXME: jitc-p & seclass are passed in a cons to SYS::%MAKE-CLOSURE -;; because a subr cannot take more than 6 required arguments. -;; TODO: remove make-closure from here, remove make-code-vector from record.d -;; make make-closure in record.d accept keyword arguments -;; this will invalidate bytecode format because it will modify FUNTAB! -(defun make-closure (&key name codevec consts seclass lambda-list documentation - jitc-p) - (sys::%make-closure name (sys::make-code-vector codevec) consts - (cons seclass jitc-p) - lambda-list documentation)) - ;; The instruction list is in <doc/impbyte.xml>. ;; classification of instructions: @@ -10614,7 +10603,7 @@ (setf (fnode-code fnode) (make-closure :name fname - :codevec + :code (macrolet ((as-word (anz) (if *big-endian* ;; BIG-ENDIAN-Processor @@ -10650,7 +10639,7 @@ (as-word (fnode-Keyword-Offset fnode))) (values)) byte-list)) - :consts + :constants (let ((l (append (make-list (fnode-Keyword-Offset fnode)) (fnode-keywords fnode) Index: subr.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/subr.d,v retrieving revision 1.247 retrieving revision 1.248 diff -u -d -r1.247 -r1.248 --- subr.d 14 Feb 2008 23:09:45 -0000 1.247 +++ subr.d 15 Feb 2008 01:50:11 -0000 1.248 @@ -949,8 +949,7 @@ LISPFUNNR(closure_consts,1) LISPFUNNR(closure_const,2) LISPFUNN(set_closure_const,3) -LISPFUNNR(make_code_vector,1) -LISPFUNNR(make_closure,6) +LISPFUN(make_closure,seclass_default,0,0,norest,key,7,(kw(name),kw(code),kw(constants),kw(seclass),kw(lambda_list),kw(documentation),kw(jitc_p))) LISPFUNN(make_constant_initfunction,1) LISPFUNN(constant_initfunction_p,1) LISPFUNN(closure_set_seclass,2) Index: constsym.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/constsym.d,v retrieving revision 1.359 retrieving revision 1.360 diff -u -d -r1.359 -r1.360 --- constsym.d 14 Feb 2008 23:09:46 -0000 1.359 +++ constsym.d 15 Feb 2008 01:50:11 -0000 1.360 @@ -771,8 +771,7 @@ LISPSYM(closure_consts,"CLOSURE-CONSTS",system) LISPSYM(closure_const,"CLOSURE-CONST",system) LISPSYM(set_closure_const,"SET-CLOSURE-CONST",system) -LISPSYM(make_code_vector,"MAKE-CODE-VECTOR",system) -LISPSYM(make_closure,"%MAKE-CLOSURE",system) +LISPSYM(make_closure,"MAKE-CLOSURE",system) /* ABI */ LISPSYM(make_constant_initfunction,"MAKE-CONSTANT-INITFUNCTION",system) /* ABI */ LISPSYM(constant_initfunction_p,"CONSTANT-INITFUNCTION-P",system) LISPSYM(closure_set_seclass,"CLOSURE-SET-SECLASS",system) @@ -1343,6 +1342,12 @@ LISPSYM(Kwin32,"WIN32",keyword) #endif LISPSYM(Kread_only,"READ-ONLY",keyword) +LISPSYM(Kcode,"CODE",keyword) +LISPSYM(Kconstants,"CONSTANTS",keyword) +LISPSYM(Kseclass,"SECLASS",keyword) +LISPSYM(Klambda_list,"LAMBDA-LIST",keyword) +LISPSYM(Kdocumentation,"DOCUMENTATION",keyword) +LISPSYM(Kjitc_p,"JITC-P",keyword) /* other symbols: */ LISPSYM(standard_char,"STANDARD-CHAR",lisp) /* type in PREDTYPE */ Index: record.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/record.d,v retrieving revision 1.127 retrieving revision 1.128 diff -u -d -r1.127 -r1.128 --- record.d 14 Feb 2008 23:09:45 -0000 1.127 +++ record.d 15 Feb 2008 01:50:11 -0000 1.128 @@ -259,12 +259,9 @@ closure as an array of fixnums >=0, <256. (SYS::CLOSURE-CONSTS closure) returns a list of all constants of a compiled closure. - (SYS::MAKE-CODE-VECTOR list) returns for a list of fixnums >=0, <256 - a simple-8bit-vector of the same length, that contains these numbers - as bytes. - (SYS::%MAKE-CLOSURE name codevec consts seclass) returns a closure with given - name (a symbol), given code-vector (a simple-bit-vector) and - further given constants. + (SYS::MAKE-CLOSURE &key name code constants seclass lambda-list documentation + jitc-p) returns a closure with given name (a symbol), given code-vector + (a list of bytes), given constants, seclass, lalist, doc string and JITC_p. (SYS::MAKE-CONSTANT-INITFUNCTION value) returns a closure that, when called with 0 arguments, returns the given value. (SYS::CONSTANT-INITFUNCTION-P object) tests whether an object was returned by @@ -376,13 +373,13 @@ VALUES1(*closure_const() = STACK_2); skipSTACK(3); } -/* (SYS::MAKE-CODE-VECTOR list) returns for a list of fixnums >=0, <256 - a simple-8bit-vector of the same length, that contains these numbers - as bytes. */ -LISPFUNNR(make_code_vector,1) { - var object bv = allocate_bit_vector(Atype_8Bit,llength(STACK_0)); /* simple-8bit-vector */ +/* make_code_vector(list) converts a list of fixnums >=0, <256 + into a simple-8bit-vector of the same length, that contains these numbers + as bytes. */ +local maygc void make_code_vector (gcv_object_t *code) { + var object bv = allocate_bit_vector(Atype_8Bit,llength(*code)); /* simple-8bit-vector */ /* fill: */ - var object listr = popSTACK(); /* list */ + var object listr = *code; /* list */ var uintB* ptr = &TheSbvector(bv)->data[0]; /* loop through the bit-vector */ while (consp(listr)) { var uintV byte; @@ -394,7 +391,8 @@ *ptr++ = (uintB)byte; listr = Cdr(listr); } - VALUES1(bv); return; + *code = bv; + return; bad_byte: pushSTACK(Car(listr)); /* TYPE-ERROR slot DATUM */ pushSTACK(O(type_uint8)); /* TYPE-ERROR slot EXPECTED-TYPE */ @@ -422,24 +420,19 @@ returns a closure with given name (a symbol), given code-vector (a simple-bit-vector), given constants, given side-effect class, lambda-list and documentation. */ -LISPFUNNR(make_closure,6) { - ASSERT(consp(STACK_2)); - var bool jitc_p = !eq(Fixnum_0,Cdr(STACK_2)); - var seclass_t seclass = parse_seclass(Car(STACK_2),STACK_5); - /* codevec must be a simple-bit-vector: */ - if (!simple_bit_vector_p(Atype_8Bit,STACK_4)) { - /* STACK_4 = codevec */ - pushSTACK(STACK_4); /* TYPE-ERROR slot DATUM */ - pushSTACK(S(simple_bit_vector)); /* TYPE-ERROR slot EXPECTED-TYPE */ - pushSTACK(STACK_(4+2)); - pushSTACK(TheSubr(subr_self)->name); - error(type_error,GETTEXT("~S: invalid code-vector ~S")); - } - /* create a new closure of length (+ 2 (length consts) lalist-p doc-p) : */ +LISPFUN(make_closure,seclass_default,0,0,norest,key,7,(kw(name),kw(code), + kw(constants),kw(seclass),kw(lambda_list),kw(documentation),kw(jitc_p))) +{ + var bool jitc_p = !eq(Fixnum_0,popSTACK()); + var seclass_t seclass = parse_seclass(STACK_2,STACK_5); + /* convert code to a simple-bit-vector: */ + if (listp(STACK_4)) make_code_vector(&STACK_4); + /* create a new closure of length + (+ 2 (length consts) lalist-p doc-p jitc_p) : */ var uintL length = 2+llength(STACK_3) + (jitc_p ? 1 : 0) +(listp(STACK_1) ? 1 : 0)+(nullp(STACK_0) || stringp(STACK_0) ? 1 : 0); if (!(length <= (uintL)(bitm(intWsize)-1))) { /* should fit into a uintW */ - pushSTACK(STACK_4/*consts */); + pushSTACK(STACK_3/* constants */); pushSTACK(STACK_6/* name */); pushSTACK(TheSubr(subr_self)->name); error(error_condition,GETTEXT("~S: function ~S is too big: ~S")); @@ -475,10 +468,10 @@ pushSTACK(S(constant_initfunction)); pushSTACK(O(constant_initfunction_code)); pushSTACK(consts); - pushSTACK(allocate_cons()); - Car(STACK_0) = O(seclass_no_se); Cdr(STACK_0) = Fixnum_0; + pushSTACK(O(seclass_no_se)); pushSTACK(Fixnum_0); /* no lalist */ pushSTACK(Fixnum_0); /* no doc */ + pushSTACK(Fixnum_0); /* no jitc */ C_make_closure(); } Index: subrkw.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/subrkw.d,v retrieving revision 1.59 retrieving revision 1.60 diff -u -d -r1.59 -r1.60 --- subrkw.d 11 Feb 2008 17:29:02 -0000 1.59 +++ subrkw.d 15 Feb 2008 01:50:11 -0000 1.60 @@ -219,3 +219,5 @@ v(1, (kw(name))) s(make_thread) #endif +v(7, (kw(name),kw(code),kw(constants),kw(seclass),kw(lambda_list),kw(documentation),kw(jitc_p)) ) +s(make_closure) Index: io.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/io.d,v retrieving revision 1.333 retrieving revision 1.334 diff -u -d -r1.333 -r1.334 --- io.d 13 Feb 2008 23:40:57 -0000 1.333 +++ io.d 15 Feb 2008 01:50:11 -0000 1.334 @@ -4223,9 +4223,7 @@ OPTARG; /* 6th argument (documentation) */ OPTARG; /* 7th argument (jitc_p) */ #undef OPTARG - { var object tmp = allocate_cons(); /* (cons seclass jitc_p( */ - Car(tmp) = STACK_3; STACK_3 = tmp; Cdr(tmp) = popSTACK(); } - funcall(L(make_closure),6); /* value1 as value */ + C_make_closure(); /* value1 as value */ } else { /* n specified -> read Codevector: Syntax: #nY(b1 ... bn), where n is a Fixnum >=0 and b1,...,bn Index: eval.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/eval.d,v retrieving revision 1.244 retrieving revision 1.245 diff -u -d -r1.244 -r1.245 --- eval.d 14 Feb 2008 23:09:45 -0000 1.244 +++ eval.d 15 Feb 2008 01:50:11 -0000 1.245 @@ -116,11 +116,11 @@ _(functionp), _(packagep), _(arrayp), _(simple_array_p), _(bit_vector_p), _(vectorp), _(simple_vector_p), _(simple_string_p), _(simple_bit_vector_p), _(type_of), _(class_of), _(find_class), _(coerce), - /* RECORD : 23 SUBRs */ + /* RECORD : 22 SUBRs */ _(record_ref), _(record_store), _(record_length), _(structure_ref), _(structure_store), _(make_structure), _(copy_structure), _(structure_type_p), _(closure_name), _(closure_codevec), - _(closure_consts), _(make_code_vector), _(make_closure), + _(closure_consts), _(make_closure), _(copy_generic_function), _(make_load_time_eval), _(function_macro_function), _(structure_object_p), _(std_instance_p), _(slot_value), _(set_slot_value), _(slot_boundp), _(slot_makunbound), @@ -167,8 +167,8 @@ _(make_random_state), _(factorial), _(exquo), _(long_float_digits), _(set_long_float_digits), _(log2), _(log10), /* other: */ -}; /* that were 501 = 542 - 41 SUBRs. - (- (+ 0 3 30 54 24 0 11 38 84 10 31 27 44 23 40 24 15 84) +}; /* that were 500 = 541 - 41 SUBRs. + (- (+ 0 3 30 54 24 0 11 38 84 10 31 27 44 22 40 24 15 84) (+ 0 0 2 0 0 0 0 0 36 0 0 0 3 0 0 0 0 0)) */ /* Now FUNTABR : */ local const Subr FUNTABR[] = { @@ -4549,8 +4549,7 @@ case (uintB)cclos_argtype_1_0_key: /* 1 required argument, &key */ REQ_ARG(); noch_0_opt_args_key: - case (uintB)cclos_argtype_0_0_key: - /* only &key */ + case (uintB)cclos_argtype_0_0_key: /* only &key */ if ((args_on_stack==0) && atomp(args)) goto unbound_optional_key_0; goto apply_cclosure_key_withlist; case (uintB)cclos_argtype_3_1_key: @@ -4562,8 +4561,7 @@ case (uintB)cclos_argtype_1_1_key: /* 1 required argument and 1 optional argument, &key */ REQ_ARG(); - case (uintB)cclos_argtype_0_1_key: - /* 1 optional argument, &key */ + case (uintB)cclos_argtype_0_1_key: /* 1 optional argument, &key */ noch_1_opt_args_key: OPT_ARG(key_1); goto noch_0_opt_args_key; ------------------------------ ------------------------------------------------------------------------- This SF.net email is sponsored by: Microsoft Defy all challenges. Microsoft(R) Visual Studio 2008. http://clk.atdmt.com/MRT/go/vse0120000070mrt/direct/01/ ------------------------------ _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest, Vol 22, Issue 16 ***************************************** |