Menu
▾
▴
clisp-cvs digest, Vol 1 #439 - 4 msgs
|
From: <cli...@li...> - 2004-04-11 03:02:27
|
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/src clos-class2.lisp,1.5,1.6 defstruct.lisp,1.23,1.24 io.d,1.209,1.210 foreign1.lisp,1.51,1.52 ChangeLog,1.2826,1.2827 (Bruno Haible) 2. clisp/src defstruct.lisp,1.24,1.25 clos-class2.lisp,1.6,1.7 ChangeLog,1.2827,1.2828 (Bruno Haible) 3. clisp/src sequence.d,1.72,1.73 ChangeLog,1.2828,1.2829 (Bruno Haible) 4. clisp/src ChangeLog,1.2829,1.2830 (Bruno Haible) --__--__-- Message: 1 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src clos-class2.lisp,1.5,1.6 defstruct.lisp,1.23,1.24 io.d,1.209,1.210 foreign1.lisp,1.51,1.52 ChangeLog,1.2826,1.2827 Date: Sat, 10 Apr 2004 14:43:35 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv18271/src Modified Files: clos-class2.lisp defstruct.lisp io.d foreign1.lisp ChangeLog Log Message: Store a structure's size in the DEFSTRUCT-DESCRIPTION. Index: clos-class2.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/clos-class2.lisp,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- clos-class2.lisp 4 Apr 2004 15:31:34 -0000 1.5 +++ clos-class2.lisp 10 Apr 2004 14:43:30 -0000 1.6 @@ -967,7 +967,7 @@ (let ((descr (get name 'sys::defstruct-description))) (when descr (let* ((names (svref descr 0)) - (all-slots (svref descr 3)) + (all-slots (svref descr 4)) (slots (remove-if-not #'sys::ds-slot-initargs ; means #'sys::ds-real-slot-p all-slots))) (setf (find-class name) Index: defstruct.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/defstruct.lisp,v retrieving revision 1.23 retrieving revision 1.24 diff -u -d -r1.23 -r1.24 --- defstruct.lisp 5 Apr 2004 19:16:26 -0000 1.23 +++ defstruct.lisp 10 Apr 2004 14:43:31 -0000 1.24 @@ -1,5 +1,5 @@ ;;; Sources for CLISP DEFSTRUCT macro -;;; Bruno Haible 1988-2003 +;;; Bruno Haible 1988-2004 ;;; Sam Steingold 1998-2004 ;;; German comments translated into English: Stefan Kain 2003-01-14 @@ -10,7 +10,7 @@ #| Explanation of the appearing data types: (get name 'DEFSTRUCT-DESCRIPTION) = - #(names type keyword-constructor slotlist defaultfun0 defaultfun1 ...) + #(names type size keyword-constructor slotlist defaultfun0 defaultfun1 ...) names is a coding of the INCLUDE-nesting for Structure name: names = (name_1 ... name_i-1 name_i) with name=name_1, @@ -22,6 +22,8 @@ = VECTOR storage as (simple-)vector = (VECTOR element-type) storage as vector with element-type + size is the structure size / list length / vector length. + keyword-constructor = NIL or the name of the keyword-constructor slotlist is a packed description of the slots of a structure: @@ -537,7 +539,7 @@ (cons (add-unquote (ds-slot-default slot)) 'NIL))) slot) - (svref incl-desc 3)))) + (svref incl-desc 4)))) ;; slotlist is the reversed list of the inherited slots (when slotlist (setq include-skip (1+ (ds-slot-offset (first slotlist))))) @@ -709,7 +711,7 @@ slotlist)))) constructor-option-list)) ;; constructor-forms = list of forms, that define the constructors. - (let ((index 4)) + (let ((index 5)) (dolist (defaultvar slotdefaultvars) (setf (ds-slot-default (find defaultvar slotlist :test #'eq :key #'(lambda (x) (ds-slot-default x)))) @@ -722,7 +724,7 @@ slotdefaultfuns)) ,@constructor-forms (%PUT ',name 'DEFSTRUCT-DESCRIPTION - (VECTOR ,namesform ',type-option ',keyword-constructor + (VECTOR ,namesform ',type-option ,size ',keyword-constructor ,(add-backquote slotlist) ,@slotdefaultvars))) ,@(if (eq type-option 'T) `((CLOS::DEFINE-STRUCTURE-CLASS ',name))) Index: foreign1.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/foreign1.lisp,v retrieving revision 1.51 retrieving revision 1.52 diff -u -d -r1.51 -r1.52 --- foreign1.lisp 16 Jan 2004 11:16:23 -0000 1.51 +++ foreign1.lisp 10 Apr 2004 14:43:32 -0000 1.52 @@ -151,7 +151,7 @@ (LAMBDA ,vars (DECLARE (COMPILE)) ,(if (and (setq h (get class 'sys::defstruct-description)) - (setq h (svref h 2))) + (setq h (svref h 3))) ;; h is the keyword constructor for the structure `(,h ,@(mapcan #'(lambda (s v) (list (intern (symbol-name s) compiler::*keyword-package*) Index: io.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/io.d,v retrieving revision 1.209 retrieving revision 1.210 diff -u -d -r1.209 -r1.210 --- io.d 4 Apr 2004 15:15:55 -0000 1.209 +++ io.d 10 Apr 2004 14:43:31 -0000 1.210 @@ -3839,9 +3839,9 @@ # (if (symbolp name) # (let ((desc (get name 'DEFSTRUCT-DESCRIPTION))) # (if desc -# (if (svref desc 2) +# (if (svref desc 3) # (values -# (apply (svref desc 2) ; der Konstruktor +# (apply (svref desc 3) ; der Konstruktor # (structure-arglist-expand name (cdr args)) # ) ) # (error "~S: Structures of type ~S cannot be read (constructor function unknown)" @@ -3965,8 +3965,8 @@ fehler(stream_error, GETTEXT("~S from ~S: no structure of type ~S has been defined")); } - # description must be a Simple-Vector of length >=4: - if (!(simple_vector_p(description) && (Svector_length(description) >= 4))) { + # description must be a Simple-Vector of length >=5: + if (!(simple_vector_p(description) && (Svector_length(description) >= 5))) { pushSTACK(*stream_); # STREAM-ERROR slot STREAM pushSTACK(name); pushSTACK(S(defstruct_description)); @@ -3975,8 +3975,8 @@ fehler(stream_error,GETTEXT("~S from ~S: bad ~S for ~S")); } # fetch constructor-function: - var object constructor = # (svref description 2) - TheSvector(description)->data[2]; + var object constructor = # (svref description 3) + TheSvector(description)->data[3]; if (nullp(constructor)) { pushSTACK(*stream_); # STREAM-ERROR slot STREAM pushSTACK(name); @@ -7948,7 +7948,7 @@ # (defun print-structure (structure stream) # (let ((description (get name 'DEFSTRUCT-DESCRIPTION))) # (if description -# (let ((readable (svref description 2))) +# (let ((readable (svref description 3))) # (write-string (if readable "#S(" "#<") stream) # (prin1 name stream) # (dolist (slot (svref description 3)) @@ -8042,16 +8042,16 @@ if (boundp(description)) { /* print structure with slot-name: */ pushSTACK(description); # stack layout: structure, name, description. - # description must be a simple-vector of length >=4 ! + # description must be a simple-vector of length >=5 ! if (!(simple_vector_p(description) - && (Svector_length(description) >= 4))) { + && (Svector_length(description) >= 5))) { bad_description: pushSTACK(S(defstruct_description)); pushSTACK(S(print)); fehler(error,GETTEXT("~S: bad ~S")); } - var bool readable = # true if (svref description 2) /= NIL - !nullp(TheSvector(description)->data[2]); + var bool readable = # true if (svref description 3) /= NIL + !nullp(TheSvector(description)->data[3]); if (readable) { # print structure re-readably: write_ascii_char(stream_,'#'); write_ascii_char(stream_,'S'); KLAMMER_AUF; @@ -8061,10 +8061,10 @@ CHECK_PRINT_READABLY(*structure_); UNREADABLE_START; } - pushSTACK(TheSvector(*(structure_ STACKop -2))->data[3]); + pushSTACK(TheSvector(*(structure_ STACKop -2))->data[4]); JUSTIFY_LAST(!some_printable_slots(STACK_0)); prin_object(stream_,*(structure_ STACKop -1)); # print name - # loop through slot-list STACK_0 = (svref description 3) : + # loop through slot-list STACK_0 = (svref description 4) : { var uintL length_limit = get_print_length(); # *PRINT-LENGTH*-limit var uintL length = 0; # previous length := 0 Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.2826 retrieving revision 1.2827 diff -u -d -r1.2826 -r1.2827 --- ChangeLog 8 Apr 2004 20:25:42 -0000 1.2826 +++ ChangeLog 10 Apr 2004 14:43:32 -0000 1.2827 @@ -1,3 +1,12 @@ +2004-04-03 Bruno Haible <br...@cl...> + + Store a structure's size in the DEFSTRUCT-DESCRIPTION. + * defstruct.lisp (defstruct): Add the instance size as third slot of + the DEFSTRUCT-DESCRIPTION. + * io.d (structure_reader, pr_structure_default): Update. + * clos-class2.lisp (define-structure-class): Update. + * foreign1.lisp (c-struct-constructor): Update. + 2004-04-08 Sam Steingold <sd...@gn...> * init.lisp: export ABORT here to avoid conflict with gray.lisp --__--__-- Message: 2 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src defstruct.lisp,1.24,1.25 clos-class2.lisp,1.6,1.7 ChangeLog,1.2827,1.2828 Date: Sat, 10 Apr 2004 14:46:51 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv18762/src Modified Files: defstruct.lisp clos-class2.lisp ChangeLog Log Message: Redefining a struct with :TYPE option must remove the class previously created with the same name. Index: clos-class2.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/clos-class2.lisp,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- clos-class2.lisp 10 Apr 2004 14:43:30 -0000 1.6 +++ clos-class2.lisp 10 Apr 2004 14:46:49 -0000 1.7 @@ -980,6 +980,8 @@ :size (if all-slots (1+ (sys::ds-slot-offset (car (last all-slots)))) 1))))))) +(defun undefine-structure-class (name) + (setf (find-class name) nil)) ;; --------------------------------------------------------------------------- Index: defstruct.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/defstruct.lisp,v retrieving revision 1.24 retrieving revision 1.25 diff -u -d -r1.24 -r1.25 --- defstruct.lisp 10 Apr 2004 14:43:31 -0000 1.24 +++ defstruct.lisp 10 Apr 2004 14:46:49 -0000 1.25 @@ -345,6 +345,8 @@ (defun clos::define-structure-class (name) ; preliminary (declare (ignore name)) (system::note-new-structure-class)) +(defun clos::undefine-structure-class (name) ; preliminary + (declare (ignore name))) (defun clos::defstruct-remove-print-object-method (name) ; preliminary (declare (ignore name)) nil) @@ -727,7 +729,9 @@ (VECTOR ,namesform ',type-option ,size ',keyword-constructor ,(add-backquote slotlist) ,@slotdefaultvars))) - ,@(if (eq type-option 'T) `((CLOS::DEFINE-STRUCTURE-CLASS ',name))) + ,(if (eq type-option 'T) + `(CLOS::DEFINE-STRUCTURE-CLASS ',name) + `(CLOS::UNDEFINE-STRUCTURE-CLASS ',name)) ,@(if (and named-option predicate-option) (ds-make-pred predicate-option type-option name initial-offset-option)) Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.2827 retrieving revision 1.2828 diff -u -d -r1.2827 -r1.2828 --- ChangeLog 10 Apr 2004 14:43:32 -0000 1.2827 +++ ChangeLog 10 Apr 2004 14:46:49 -0000 1.2828 @@ -1,5 +1,11 @@ 2004-04-03 Bruno Haible <br...@cl...> + * defstruct.lisp (defstruct): When defining a structure with :TYPE + option, remove any previously defined class of the same name. + * clos-class2.lisp (undefine-structure-class): New function. + +2004-04-03 Bruno Haible <br...@cl...> + Store a structure's size in the DEFSTRUCT-DESCRIPTION. * defstruct.lisp (defstruct): Add the instance size as third slot of the DEFSTRUCT-DESCRIPTION. --__--__-- Message: 3 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src sequence.d,1.72,1.73 ChangeLog,1.2828,1.2829 Date: Sat, 10 Apr 2004 14:47:59 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv19011/src Modified Files: sequence.d ChangeLog Log Message: Don't pass * to the functions that expect a type specifier. Index: sequence.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/sequence.d,v retrieving revision 1.72 retrieving revision 1.73 diff -u -d -r1.72 -r1.73 --- sequence.d 31 Mar 2004 12:23:51 -0000 1.72 +++ sequence.d 10 Apr 2004 14:47:56 -0000 1.73 @@ -199,7 +199,7 @@ if (consp(name3) && integerp(Car(name3))) pushSTACK(Car(name3)); else pushSTACK(unbound); } - var uintB atype = eltype_code(name2); + var uintB atype = (eq(name2,S(mal)) ? Atype_T : eltype_code(name2)); if (atype==Atype_T) { # (VECTOR T) name = S(vector); goto expanded; } else if (atype==Atype_Char) { # (VECTOR CHARACTER) Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.2828 retrieving revision 1.2829 diff -u -d -r1.2828 -r1.2829 --- ChangeLog 10 Apr 2004 14:46:49 -0000 1.2828 +++ ChangeLog 10 Apr 2004 14:47:57 -0000 1.2829 @@ -1,5 +1,10 @@ 2004-04-03 Bruno Haible <br...@cl...> + * sequence.d (valid_type1): Call eltype_code only if the element-type + is not *. + +2004-04-03 Bruno Haible <br...@cl...> + * defstruct.lisp (defstruct): When defining a structure with :TYPE option, remove any previously defined class of the same name. * clos-class2.lisp (undefine-structure-class): New function. --__--__-- Message: 4 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src ChangeLog,1.2829,1.2830 Date: Sat, 10 Apr 2004 16:10:57 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32528 Modified Files: ChangeLog Log Message: Fix breakage at end of file. Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.2829 retrieving revision 1.2830 diff -u -d -r1.2829 -r1.2830 --- ChangeLog 10 Apr 2004 14:47:57 -0000 1.2829 +++ ChangeLog 10 Apr 2004 16:10:54 -0000 1.2830 @@ -23540,3 +23540,129 @@ 1997-10-20 Bruno Haible <br...@li...> * disassem.lsp (disassemble-machine-code) [UNIX]: Inhibit line + breaks, 1 instruction per line, otherwise the instruction gets + filtered away. + +1997-10-19 Bruno Haible <br...@li...> + + * conditio.lsp: Conditionalize upon feature ANSI-CL, not dpANS. + * defs2.lsp, defs3.lsp, init.lsp, loop.lsp: Likewise. + +1997-10-12 Jörg Höhle <Joe...@ze...> + + * amigasock.lsp: New file. + +1997-10-08 Jörg Höhle <Joe...@ze...> + + * eval.d (interpret_bytecode (cod_throw)): Tweak message. + +1997-10-06 Jörg Höhle <Joe...@ze...> + + * cfgamiga.lsp (machine-instance): Prefix with "localhost". + * erramiga.d (error200_msg_table): Add some translations. + +1997-09-30 Bruno Haible <br...@li...> + + * utils/gcc-cccp/Makefile.msvc: Set stack size for cccp.exe. + * asmi386.sh: For the sake of msvc5, which assembles relative + addresses in an unpredictable way, turn jump tables into absolute, + not relative, addresses. + +1997-09-28 Bruno Haible <br...@li...> + + * charstrg.d (copy_string, NSTRING-UPCASE, NSTRING-DOWNCASE) + (NSTRING-CAPITALIZE): Make reentrant and multithread-safe. + +1997-09-28 Bruno Haible <br...@li...> + + Stack overflow robustness on Win32: + * lispbibl.d (NO_SP_CHECK, NOCOST_SP_CHECK): New macros. SP checks + are enabled if AMIGAOS || (WIN32_NATIVE && !CAN_HANDLE_WP_FAULT). + * spvw.d (do_gar_col_simple, do_gar_col): If WIN32_NATIVE && + CAN_HANDLE_WP_FAULT, check for stack overflow just before GC, + because a stack overflow during GC would be unrecoverable. + * spvw.d (subst_circ_mark, stack_overflow_handler) + (main_exception_filter): Put in the right #ifdefs. + * spvw.d (stack_overflow_stack): New variable. + (main): Set it. + +1997-09-28 Bruno Haible <br...@li...> + + * lispbibl.d (map_heap_function): Renamed from mapper_function. + (map_heap_objects): Change declaration. + * spvw.d (map_heap_objects): Likewise. + +1997-09-28 Bruno Haible <br...@li...> + + * array.d (initial_contents_locals): New structure. + (initial_contents_aux): Make reentrant and multithread-safe. + * lispbibl.d (map_sequence): Declare. + * sequence.d (map_sequence): New function. + +1997-09-28 Bruno Haible <br...@li...> + + * spvw.d (everything_ready): Remove unused variable. + +1997-09-28 Bruno Haible <br...@li...> + + Use `const' qualifier when possible, especially on constant arrays. + This allows constant arrays to be put into the raw data section. + * arilev1c.d (copy_loop_up, copy_loop_down, or_loop_up, xor_loop_up) + (and_loop_up, eqv_loop_up, nand_loop_up, nor_loop_up, andc2_loop_up) + (orc2_loop_up, and_test_loop_up, test_loop_up, compare_loop_up) + (add_loop_down, addto_loop_down, sub_loop_down, subx_loop_down) + (subfrom_loop_down, shiftleftcopy_loop_down, shiftrightcopy_loop_up) + (mulu_loop_down, muluadd_loop_down, mulusub_loop_down) + (divucopy_loop_up): Use `const'. + * arilev1e.d (copy_loop_up, copy_loop_down, or_loop_up, xor_loop_up) + (and_loop_up, eqv_loop_up, nand_loop_up, nor_loop_up, andc2_loop_up) + (orc2_loop_up, and_test_loop_up, test_loop_up, compare_loop_up) + (add_loop_down, addto_loop_down, sub_loop_down, subx_loop_down) + (subfrom_loop_down, shiftleftcopy_loop_down, shiftrightcopy_loop_up) + (mulu_loop_down, muluadd_loop_down, mulusub_loop_down) + (divucopy_loop_up): Use `const'. + * arilev1i.d (copy_loop_up, copy_loop_down, or_loop_up, xor_loop_up) + (and_loop_up, eqv_loop_up, nand_loop_up, nor_loop_up, andc2_loop_up) + (orc2_loop_up, and_test_loop_up, test_loop_up, compare_loop_up) + (add_loop_down, addto_loop_down, sub_loop_down, subx_loop_down) + (subfrom_loop_down, shiftleftcopy_loop_down, shiftrightcopy_loop_up) + (mulu_loop_down, muluadd_loop_down, mulusub_loop_down) + (divucopy_loop_up): Use `const'. + * array.d (type_table): Use `const'. + * charstrg.d (up_case_table, down_case_table, charname_table_codes) + (char_name, name_char): Use `const'. + * control.d (fsubr_tab): Use `const'. + * debug.d (frame_up_table, frame_down_table, test_mode_arg): Use + `const'. + * eval.d (FUNTAB, FUNTABR, cod_labels): Use `const'. + * graph.d (EGA_colors, gr_colors, g320x200x16_regs, g320x200x16_info) + (g640x200x16_regs, g640x200x16_info, g640x350x16_regs) + (g640x350x16_info, g640x480x16_regs, g640x480x16_info) + (g320x200x256_regs, g320x200x256_info, g320x240x256_regs) + (g320x240x256_info, g320x400x256_regs, g320x400x256_info) + (g360x480x256_regs, g360x480x256_info, g640x480x2_regs) + (g640x480x2_info, g640x480x256_regs, g640x480x256_info) + (g800x600x256_regs, g800x600x256_info, g1024x768x256_regs) + (g1024x768x256_info, default_red, default_green, default_blue) + (color16, et4000_set_regs, set_regs, mono_colors, EGA_colors) + (VGA_colors, gr_colors, font, gr_text, GRAPH-INIT): Use `const'. + * hashtabl.d (tuple_half_1, tuple_half_2): Use `const'. + * intmal.d (mulu_2loop_down, mulu_2bigloop_down, fakul_table): Use + `const'. + * intprint.d (table, UDS_to_DIGITS): Use `const'. + * io.d (orig_syntax_table, orig_readtable, SET-READTABLE-CASE) + (attribute_table, char_reader, pr_character, pr_stream): Use `const'. + * lisparit.d (pi_mantisse, ln2_mantisse, ln10_mantisse): Use `const'. + * lispbibl.d (fsubr_tab): Use `const'. + * predtype.d (init_hs_locals_rest): Use `const'. + * realrand.d (multiplier): Use `const'. + * sequence.d (test_start_end, test_start_end_1): Use `const'. + * spvw.d (pname_table, package_index_table, init_symbol_tab_2) + (fsubr_data_tab, object_initstring_tab, features_initstring) + (init_object_tab, banner, banner2, banner3, main) + (loadmem_aktualisiere, copyright_notice): Use `const'. + +1997-09-27 Bruno Haible <br...@li...> + + * acspecific.m4 (AC_FUNC_VFORK): Fix so that it works right when + cross-compiling. --__--__-- _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest |