Menu
▾
▴
clisp-cvs Digest, Vol 20, Issue 5
|
From: <cli...@li...> - 2007-12-04 16:20:47
|
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 subr.d, 1.235, 1.236 stream.d, 1.591, 1.592 list.d, 1.76, 1.77 foreign.d, 1.168, 1.169 eval.d, 1.219, 1.220 constsym.d, 1.345, 1.346 bytecode.d, 1.5, 1.6 ChangeLog, 1.5811, 1.5812 (Sam Steingold) 2. clisp/src charstrg.d,1.134,1.135 ChangeLog,1.5812,1.5813 (Sam Steingold) 3. clisp/src spvw_gcmark.d,1.6,1.7 ChangeLog,1.5813,1.5814 (Sam Steingold) ---------------------------------------------------------------------- Message: 1 Date: Tue, 04 Dec 2007 15:47:08 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src subr.d, 1.235, 1.236 stream.d, 1.591, 1.592 list.d, 1.76, 1.77 foreign.d, 1.168, 1.169 eval.d, 1.219, 1.220 constsym.d, 1.345, 1.346 bytecode.d, 1.5, 1.6 ChangeLog, 1.5811, 1.5812 To: cli...@li... Message-ID: <E1I...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv17651/src Modified Files: subr.d stream.d list.d foreign.d eval.d constsym.d bytecode.d ChangeLog Log Message: rurban: <17_liststern> (liststern->liststar; cod_unliststern->cod_unliststar; cod_liststern_push->cod_liststar_push; unliststern_unbound->unliststar_unbound) Index: list.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/list.d,v retrieving revision 1.76 retrieving revision 1.77 diff -u -d -r1.76 -r1.77 --- list.d 27 Nov 2007 17:56:30 -0000 1.76 +++ list.d 4 Dec 2007 15:47:03 -0000 1.77 @@ -916,7 +916,7 @@ VALUES1(listof(argcount)); } -LISPFUN(liststern,seclass_no_se,1,0,rest,nokey,0,NIL) +LISPFUN(liststar,seclass_no_se,1,0,rest,nokey,0,NIL) { /* (LIST* obj1 {object}), CLTL p. 267 */ /* bisherige Gesamtliste bereits im Stack */ /* die argcount restlichen Argumente vor diese Liste consen: */ Index: bytecode.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/bytecode.d,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- bytecode.d 16 Aug 2001 20:41:06 -0000 1.5 +++ bytecode.d 4 Dec 2007 15:47:04 -0000 1.6 @@ -66,7 +66,7 @@ # (8) optional and keyword arguments BYTECODE(cod_push_unbound) BYTECODE(cod_unlist) -BYTECODE(cod_unliststern) +BYTECODE(cod_unliststar) BYTECODE(cod_jmpifboundp) BYTECODE(cod_boundp) BYTECODE(cod_unbound_nil) @@ -113,7 +113,7 @@ BYTECODE(cod_svref) BYTECODE(cod_svset) BYTECODE(cod_list) -BYTECODE(cod_liststern) +BYTECODE(cod_liststar) # (16) combined operations BYTECODE(cod_nil_push) BYTECODE(cod_t_push) @@ -140,7 +140,7 @@ BYTECODE(cod_cdr_push) BYTECODE(cod_cons_push) BYTECODE(cod_list_push) -BYTECODE(cod_liststern_push) +BYTECODE(cod_liststar_push) BYTECODE(cod_nil_store) BYTECODE(cod_t_store) BYTECODE(cod_load_storec) Index: stream.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/stream.d,v retrieving revision 1.591 retrieving revision 1.592 diff -u -d -r1.591 -r1.592 --- stream.d 2 Dec 2007 16:35:00 -0000 1.591 +++ stream.d 4 Dec 2007 15:47:02 -0000 1.592 @@ -8669,7 +8669,7 @@ pushSTACK(code_char(as_chart(*ptr))); ptr++; count++; } until (*ptr=='\0'); pushSTACK(make_key_event(event)); count++; - funcall(L(liststern),count); + funcall(L(liststar),count); } # and push on STACK_0: { Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.5811 retrieving revision 1.5812 diff -u -d -r1.5811 -r1.5812 --- ChangeLog 3 Dec 2007 18:25:26 -0000 1.5811 +++ ChangeLog 4 Dec 2007 15:47:04 -0000 1.5812 @@ -1,3 +1,12 @@ +2007-12-03 Reini Urban <ru...@x-...> + + <17_liststern> + * bytecode.d, constsym.d, eval.d, foreign.d, list.d, stream.d, subr.d: + (liststern): rename to liststar + * bytecode.d, eval.d (cod_unliststern): rename to cod_unliststar + (cod_liststern_push): rename bytecode to cod_liststar_push (LIST*&PUSH) + * eval.d: rename label unliststern_unbound to unliststar_unbound + 2007-12-03 Sam Steingold <sd...@gn...> * configure, makemake.in: support spaces in the build directory name Index: subr.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/subr.d,v retrieving revision 1.235 retrieving revision 1.236 diff -u -d -r1.235 -r1.236 --- subr.d 3 Dec 2007 16:09:09 -0000 1.235 +++ subr.d 4 Dec 2007 15:47:02 -0000 1.236 @@ -632,7 +632,7 @@ LISPFUNNR(conses_p,2) LISPFUN(last,seclass_read,1,1,norest,nokey,0,NIL) LISPFUN(list,seclass_no_se,0,0,rest,nokey,0,NIL) -LISPFUN(liststern,seclass_no_se,1,0,rest,nokey,0,NIL) +LISPFUN(liststar,seclass_no_se,1,0,rest,nokey,0,NIL) LISPFUN(make_list,seclass_no_se,1,0,norest,key,1, (kw(initial_element)) ) LISPFUN(append,seclass_read,0,0,rest,nokey,0,NIL) LISPFUNNR(copy_list,1) Index: eval.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/eval.d,v retrieving revision 1.219 retrieving revision 1.220 diff -u -d -r1.219 -r1.220 --- eval.d 3 Dec 2007 16:09:09 -0000 1.219 +++ eval.d 4 Dec 2007 15:47:04 -0000 1.220 @@ -187,7 +187,7 @@ _(class_tuple_gethash), /* IO : 0 SUBRs */ /* LIST : 4 SUBRs */ - _(list), _(liststern), _(append), _(nconc), + _(list), _(liststar), _(append), _(nconc), /* MISC : 0 SUBRs */ /* PACKAGE : 0 SUBRs */ /* PATHNAME : 0 SUBRs */ @@ -7134,7 +7134,7 @@ do { pushSTACK(unbound); } until (--n == 0); goto next_byte; } - CASE cod_unliststern: # (UNLIST* n m) + CASE cod_unliststar: /* (UNLIST* n m) */ { var uintC n; var uintC m; @@ -7142,12 +7142,12 @@ U_operand(m); var object l = value1; do { - if (atomp(l)) goto unliststern_unbound; + if (atomp(l)) goto unliststar_unbound; pushSTACK(Car(l)); l = Cdr(l); } until (--n == 0); pushSTACK(l); goto next_byte; - unliststern_unbound: + unliststar_unbound: if (n > m) error_apply_toofew(S(lambda),l); do { pushSTACK(unbound); } until (--n == 0); pushSTACK(NIL); @@ -7944,7 +7944,7 @@ with_saved_context( { object res = listof(n); pushSTACK(res); } ); } goto next_byte; - CASE cod_liststern: # (LIST* n) + CASE cod_liststar: /* (LIST* n) */ { var uintC n; U_operand(n); @@ -7960,7 +7960,7 @@ }); } goto next_byte; - CASE cod_liststern_push: # (LIST*&PUSH n) + CASE cod_liststar_push: /* (LIST*&PUSH n) */ { var uintC n; U_operand(n); Index: foreign.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/foreign.d,v retrieving revision 1.168 retrieving revision 1.169 diff -u -d -r1.168 -r1.169 --- foreign.d 26 Nov 2007 16:42:11 -0000 1.168 +++ foreign.d 4 Dec 2007 15:47:04 -0000 1.169 @@ -546,7 +546,7 @@ TheFfunction(obj)->ff_flags = STACK_0; STACK_3 = obj; } - pushSTACK(fixnum(f_index)); funcall(L(liststern),4); pushSTACK(value1); + pushSTACK(fixnum(f_index)); funcall(L(liststar),4); pushSTACK(value1); /* Stack layout: fun, obj, acons. */ { /* Put it into the hash table. */ var object new_cons = allocate_cons(); Index: constsym.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/constsym.d,v retrieving revision 1.345 retrieving revision 1.346 diff -u -d -r1.345 -r1.346 --- constsym.d 3 Dec 2007 16:09:09 -0000 1.345 +++ constsym.d 4 Dec 2007 15:47:04 -0000 1.346 @@ -484,7 +484,7 @@ LISPSYM(conses_p,"CONSES-P",system) /* ABI */ LISPSYM(last,"LAST",lisp) LISPSYM(list,"LIST",lisp) -LISPSYM(liststern,"LIST*",lisp) +LISPSYM(liststar,"LIST*",lisp) LISPSYM(make_list,"MAKE-LIST",lisp) LISPSYM(append,"APPEND",lisp) LISPSYM(copy_list,"COPY-LIST",lisp) ------------------------------ Message: 2 Date: Tue, 04 Dec 2007 15:50:36 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src charstrg.d,1.134,1.135 ChangeLog,1.5812,1.5813 To: cli...@li... Message-ID: <E1I...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv19175/src Modified Files: charstrg.d ChangeLog Log Message: rurban: <18_test_index_macro> Index: charstrg.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/charstrg.d,v retrieving revision 1.134 retrieving revision 1.135 diff -u -d -r1.134 -r1.135 --- charstrg.d 3 Dec 2007 16:09:10 -0000 1.134 +++ charstrg.d 4 Dec 2007 15:50:34 -0000 1.135 @@ -2243,35 +2243,35 @@ } /* Macro: checks an index-argument - test_index(woher,wohin_zuweisung,def,default,vergleich,grenze,ucname,lcname) - woher : expression, where the index (as object) comes from. - wohin_zuweisung : assigns the result (as uintV) . + test_index(from,to_setter,def,default,uplimit_cmp,upper_limit,ucname,lcname) + from : expression, where the index (as object) comes from. + to_setter : assigns the result (as uintV) . def : 0 if we do not have to test for default values, 1 if the default is set in on unbound, 2 if the default is set in on unbound or NIL. default : expression, that serves as default value in this case. - grenze : upper limit - vergleich : comparison with upper limit + upper_limit : upper limit + uplimit_cmp : comparison with upper limit kw : keyword, that identifies the index, or nullobj */ -#define test_index(woher,wohin_zuweisung,def,default,vergleich,grenze,kw) \ - { var object index = woher; /* index-argument */ \ +#define test_index(from,to_setter,def,default,uplimit_cmp,upper_limit,kw) \ + { var object index = from; /* index-argument */ \ if (def && (!boundp(index) || (def == 2 && nullp(index)))) \ - { wohin_zuweisung default; } \ + { to_setter default; } \ else { /* must be an integer: */ \ if (!integerp(index)) \ { if (def==2) error_int_null(kw,index); else error_int(kw,index); } \ /* index is an integer. */ \ if (!(positivep(index))) \ - { error_posint(kw,index); } \ + { error_posint(kw,index); } \ /* index is >=0. */ \ if (!((posfixnump(index)) && \ - ((wohin_zuweisung posfixnum_to_V(index)) vergleich grenze))) { \ - if (0 vergleich 0) \ - /* "<= grenze" - comparison not satisfied (grenze == limit) */ \ - { error_cmp_inclusive(kw,index,grenze); } \ + ((to_setter posfixnum_to_V(index)) uplimit_cmp upper_limit))) { \ + if (0 uplimit_cmp 0) \ + /* "<= upper_limit" - comparison not satisfied (upper_limit == limit) */ \ + { error_cmp_inclusive(kw,index,upper_limit); } \ else \ - /* "< grenze" - comparison not satisfied (grenze == limit) */ \ - { error_cmp_exclusive(kw,index,grenze); } \ + /* "< upper_limit" - comparison not satisfied (upper_limit == limit) */ \ + { error_cmp_exclusive(kw,index,upper_limit); } \ } \ }} Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.5812 retrieving revision 1.5813 diff -u -d -r1.5812 -r1.5813 --- ChangeLog 4 Dec 2007 15:47:04 -0000 1.5812 +++ ChangeLog 4 Dec 2007 15:50:34 -0000 1.5813 @@ -1,5 +1,7 @@ 2007-12-03 Reini Urban <ru...@x-...> + <18_test_index_macro> + * charstrg.d (test_index): englishify the macro arguments <17_liststern> * bytecode.d, constsym.d, eval.d, foreign.d, list.d, stream.d, subr.d: (liststern): rename to liststar ------------------------------ Message: 3 Date: Tue, 04 Dec 2007 16:20:39 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src spvw_gcmark.d,1.6,1.7 ChangeLog,1.5813,1.5814 To: cli...@li... Message-ID: <E1I...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv30649/src Modified Files: spvw_gcmark.d ChangeLog Log Message: rurban: <19_gcmark_vars> (dies->curr; dies_->curr_; nachf->succ; vorg->pred; vorvorg->prepred) Index: spvw_gcmark.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/spvw_gcmark.d,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- spvw_gcmark.d 25 Jan 2005 09:19:33 -0000 1.6 +++ spvw_gcmark.d 4 Dec 2007 16:20:33 -0000 1.7 @@ -2,212 +2,212 @@ local void gc_mark (object obj) { - var object dies = obj; /* current object */ - var object vorg = nullobj; /* predecessor-object */ + var object curr = obj; /* current object */ + var object pred = nullobj; /* predecessor-object */ IF_DEBUG_GC_MARK(fprintf(stderr,"gc_mark obj = 0x%"PRIoint"x\n", as_oint(obj))); #define down_pair() \ - if (in_old_generation(dies,typecode(dies),1)) \ + if (in_old_generation(curr,typecode(curr),1)) \ goto up; /* do not mark older generation */ \ - { var gcv_object_t* dies_ = (gcv_object_t*)ThePointer(dies); \ - if (marked(dies_)) goto up; /* marked -> go up */ \ - MARK(dies_); /* mark */ \ + { var gcv_object_t* curr_ = (gcv_object_t*)ThePointer(curr); \ + if (marked(curr_)) goto up; /* marked -> go up */ \ + MARK(curr_); /* mark */ \ } \ - { var object dies_ = objectplus(dies,(soint)(sizeof(cons_)-sizeof(gcv_object_t))<<(oint_addr_shift-addr_shift)); \ + { var object curr_ = objectplus(curr,(soint)(sizeof(cons_)-sizeof(gcv_object_t))<<(oint_addr_shift-addr_shift)); \ /* start with the last pointer */ \ - var object nachf = *(gcv_object_t*)ThePointer(dies_); /* successor */ \ - *(gcv_object_t*)ThePointer(dies_) = vorg; /* store predecessor */ \ - vorg = dies_; /* current object becomes new predecessor */ \ - dies = nachf; /* successor becomes current object */ \ + var object succ = *(gcv_object_t*)ThePointer(curr_); /* successor */\ + *(gcv_object_t*)ThePointer(curr_) = pred; /* store predecessor */ \ + pred = curr_; /* current object becomes new predecessor */ \ + curr = succ; /* successor becomes current object */ \ goto down; /* and descent */ \ } #define up_pair() \ - { MARK(ThePointer(vorg)); /* mark again */ \ - dies = vorg; /* Cons becomes object */ \ - vorg = vorvorg; goto up; /* go further up */ \ + { MARK(ThePointer(pred)); /* mark again */ \ + curr = pred; /* Cons becomes object */ \ + pred = prepred; goto up; /* go further up */ \ } #define down_varobject(The,first_offset,last_offset) \ - if (in_old_generation(dies,typecode(dies),0)) \ + if (in_old_generation(curr,typecode(curr),0)) \ goto up; /* do not mark older generation */ \ - { var gcv_object_t* dies_ = (gcv_object_t*)The(dies); \ - if (marked(dies_)) goto up; /* marked -> up */ \ - MARK(dies_); /* mark */ \ - mark(pointerplus(dies_,first_offset)); /* mark first pointer */ \ + { var gcv_object_t* curr_ = (gcv_object_t*)The(curr); \ + if (marked(curr_)) goto up; /* marked -> up */ \ + MARK(curr_); /* mark */ \ + mark(pointerplus(curr_,first_offset)); /* mark first pointer */ \ } \ - { var object dies_ = objectplus(dies,(soint)(last_offset)<<(oint_addr_shift-addr_shift)); \ + { var object curr_ = objectplus(curr,(soint)(last_offset)<<(oint_addr_shift-addr_shift)); \ /* start with the last pointer */ \ - var object nachf = *(gcv_object_t*)The(dies_); /* successor */ \ - *(gcv_object_t*)The(dies_) = vorg; /* store predecessor */ \ - vorg = dies_; /* current object becomes new predecessor */ \ - dies = nachf; /* predecessor becomes current object */ \ + var object succ = *(gcv_object_t*)The(curr_); /* successor */ \ + *(gcv_object_t*)The(curr_) = pred; /* store predecessor */ \ + pred = curr_; /* current object becomes new predecessor */ \ + curr = succ; /* predecessor becomes current object */ \ goto down; /* and descent */ \ } #define up_varobject(first_offset) \ - { dies = objectplus(vorg,-(soint)(first_offset)<<(oint_addr_shift-addr_shift)); /* becomes current object */ \ - vorg = vorvorg; goto up; /* go further up */ \ + { curr = objectplus(pred,-(soint)(first_offset)<<(oint_addr_shift-addr_shift)); /* becomes current object */ \ + pred = prepred; goto up; /* go further up */ \ } #define down_nopointers(The) \ - if (in_old_generation(dies,typecode(dies),0)) \ + if (in_old_generation(curr,typecode(curr),0)) \ goto up; /* do not mark older generation */ \ - MARK(The(dies)); /* mark */ \ + MARK(The(curr)); /* mark */ \ goto up; /* and up */ #define down_iarray() \ - if (in_old_generation(dies,typecode(dies),0)) \ + if (in_old_generation(curr,typecode(curr),0)) \ goto up; /* do not mark older generation */ \ - { var gcv_object_t* dies_ = (gcv_object_t*)TheIarray(dies); \ - if (marked(dies_)) goto up; /* marked -> up */ \ - MARK(dies_); /* mark */ \ + { var gcv_object_t* curr_ = (gcv_object_t*)TheIarray(curr); \ + if (marked(curr_)) goto up; /* marked -> up */ \ + MARK(curr_); /* mark */ \ } \ - { var object dies_ = objectplus(dies,(soint)(iarray_data_offset)<<(oint_addr_shift-addr_shift)); \ + { var object curr_ = objectplus(curr,(soint)(iarray_data_offset)<<(oint_addr_shift-addr_shift)); \ /* data vector is the first and only pointer */ \ - var object nachf = *(gcv_object_t*)TheIarray(dies_); /* successor */ \ - *(gcv_object_t*)TheIarray(dies_) = vorg; /* store predecessor */ \ - MARK(TheIarray(dies_)); /* mark first and only pointer */ \ - vorg = dies_; /* current object becomes new predecessor */ \ - dies = nachf; /* predecessor becomes current object */ \ + var object succ = *(gcv_object_t*)TheIarray(curr_); /* successor */ \ + *(gcv_object_t*)TheIarray(curr_) = pred; /* store predecessor */ \ + MARK(TheIarray(curr_)); /* mark first and only pointer */ \ + pred = curr_; /* current object becomes new predecessor */ \ + curr = succ; /* predecessor becomes current object */ \ goto down; /* and descent */ \ } #define up_iarray() \ - { dies = objectplus(vorg,-(soint)iarray_data_offset<<(oint_addr_shift-addr_shift)); /* array becomes current object */ \ - vorg = vorvorg; goto up; /* go further up */ \ + { curr = objectplus(pred,-(soint)iarray_data_offset<<(oint_addr_shift-addr_shift)); /* array becomes current object */ \ + pred = prepred; goto up; /* go further up */ \ } #define down_sistring() \ - if (in_old_generation(dies,typecode(dies),0)) \ + if (in_old_generation(curr,typecode(curr),0)) \ goto up; /* do not mark older generation */ \ - { var gcv_object_t* dies_ = (gcv_object_t*)TheSistring(dies); \ - if (marked(dies_)) goto up; /* marked -> up */ \ - MARK(dies_); /* mark */ \ + { var gcv_object_t* curr_ = (gcv_object_t*)TheSistring(curr); \ + if (marked(curr_)) goto up; /* marked -> up */ \ + MARK(curr_); /* mark */ \ } \ - { var object dies_ = objectplus(dies,(soint)(sistring_data_offset)<<(oint_addr_shift-addr_shift)); \ + { var object curr_ = objectplus(curr,(soint)(sistring_data_offset)<<(oint_addr_shift-addr_shift)); \ /* data vector is the first and only pointer */ \ - var object nachf = *(gcv_object_t*)TheSistring(dies_); /* successor */ \ - *(gcv_object_t*)TheSistring(dies_) = vorg; /* store predecessor */ \ - MARK(TheSistring(dies_)); /* mark first and only pointer */ \ - vorg = dies_; /* current object becomes new predecessor */ \ - dies = nachf; /* predecessor becomes current object */ \ + var object succ = *(gcv_object_t*)TheSistring(curr_); /* successor */\ + *(gcv_object_t*)TheSistring(curr_) = pred; /* store predecessor */ \ + MARK(TheSistring(curr_)); /* mark first and only pointer */ \ + pred = curr_; /* current object becomes new predecessor */ \ + curr = succ; /* predecessor becomes current object */ \ goto down; /* and descent */ \ } #define up_sistring() \ - { dies = objectplus(vorg,-(soint)sistring_data_offset<<(oint_addr_shift-addr_shift)); /* array becomes current object */ \ - vorg = vorvorg; goto up; /* go further up */ \ + { curr = objectplus(pred,-(soint)sistring_data_offset<<(oint_addr_shift-addr_shift)); /* array becomes current object */ \ + pred = prepred; goto up; /* go further up */ \ } #define down_svector() \ - if (in_old_generation(dies,typecode(dies),0)) \ + if (in_old_generation(curr,typecode(curr),0)) \ goto up; /* do not mark older generation */ \ - { var gcv_object_t* dies_ = (gcv_object_t*)TheSvector(dies); \ - if (marked(dies_)) goto up; /* marked -> up */ \ - MARK(dies_); /* mark */ \ + { var gcv_object_t* curr_ = (gcv_object_t*)TheSvector(curr); \ + if (marked(curr_)) goto up; /* marked -> up */ \ + MARK(curr_); /* mark */ \ } \ - { var uintL len = Svector_length(dies); \ + { var uintL len = Svector_length(curr); \ if (len==0) goto up; /* Length 0: up again */ \ - {var object dies_ = objectplus(dies,((soint)offsetofa(svector_,data) << (oint_addr_shift-addr_shift)) \ + {var object curr_ = objectplus(curr,((soint)offsetofa(svector_,data) << (oint_addr_shift-addr_shift)) \ /* the "<< 1" and "/2" are a workaround against a gcc-2.7.2 \ missed optimization in WIDE_SOFT mode */ \ + (((soint)len << 1) * (soint)(sizeof(gcv_object_t)/2) << (oint_addr_shift-addr_shift)) \ - - ((soint)sizeof(gcv_object_t) << (oint_addr_shift-addr_shift)) ); \ + - ((soint)sizeof(gcv_object_t) << (oint_addr_shift-addr_shift)) );\ /* start with the last pointer */ \ - var object nachf = *(gcv_object_t*)TheSvector(dies_); /* successor */ \ - *(gcv_object_t*)TheSvector(dies_) = vorg; /* store predecessor */ \ - mark(&TheSvector(dies)->data[0]); /* mark first pointer */ \ - vorg = dies_; /* current object becomes new predecessor */ \ - dies = nachf; /* predecessor becomes current object */ \ + var object succ = *(gcv_object_t*)TheSvector(curr_); /* successor */\ + *(gcv_object_t*)TheSvector(curr_) = pred; /* store predecessor */ \ + mark(&TheSvector(curr)->data[0]); /* mark first pointer */ \ + pred = curr_; /* current object becomes new predecessor */ \ + curr = succ; /* predecessor becomes current object */ \ goto down; /* and descent */ \ }} #define up_svector() \ - { dies = objectplus(vorg,-(soint)offsetofa(svector_,data)<<(oint_addr_shift-addr_shift)); /* Svector becomes current object */ \ - vorg = vorvorg; goto up; /* go further up */ \ + { curr = objectplus(pred,-(soint)offsetofa(svector_,data)<<(oint_addr_shift-addr_shift)); /* Svector becomes current object */ \ + pred = prepred; goto up; /* go further up */ \ } #define down_lrecord() \ - if (in_old_generation(dies,typecode(dies),0)) \ + if (in_old_generation(curr,typecode(curr),0)) \ goto up; /* do not mark older generation */ \ - { var gcv_object_t* dies_ = (gcv_object_t*)TheLrecord(dies); \ - if (marked(dies_)) goto up; /* marked -> up */ \ - MARK(dies_); /* marked */ \ + { var gcv_object_t* curr_ = (gcv_object_t*)TheLrecord(curr); \ + if (marked(curr_)) goto up; /* marked -> up */ \ + MARK(curr_); /* marked */ \ } \ - { var uintL len = Lrecord_nonweak_length(dies); \ + { var uintL len = Lrecord_nonweak_length(curr); \ if (len==0) goto up; /* Length 0: up again */ \ - {var object dies_ = objectplus(dies,((soint)offsetofa(record_,recdata) << (oint_addr_shift-addr_shift)) \ + {var object curr_ = objectplus(curr,((soint)offsetofa(record_,recdata) << (oint_addr_shift-addr_shift)) \ /* the "<< 1" and "/2" are a workaround against a gcc-2.7.2 \ missed optimization in WIDE_SOFT mode */ \ + (((soint)len << 1) * (soint)(sizeof(gcv_object_t)/2) << (oint_addr_shift-addr_shift)) \ - - ((soint)sizeof(gcv_object_t) << (oint_addr_shift-addr_shift)) ); \ + - ((soint)sizeof(gcv_object_t) << (oint_addr_shift-addr_shift)) );\ /* start with the last pointer */ \ - var object nachf = *(gcv_object_t*)TheLrecord(dies_); /* successor */ \ - *(gcv_object_t*)TheLrecord(dies_) = vorg; /* store predecessor */ \ - mark(&TheLrecord(dies)->recdata[0]); /* mark first pointer */ \ - vorg = dies_; /* current object becomes new predecessor */ \ - dies = nachf; /* predecessor becomes current object */ \ + var object succ = *(gcv_object_t*)TheLrecord(curr_); /* successor */\ + *(gcv_object_t*)TheLrecord(curr_) = pred; /* store predecessor */ \ + mark(&TheLrecord(curr)->recdata[0]); /* mark first pointer */ \ + pred = curr_; /* current object becomes new predecessor */ \ + curr = succ; /* predecessor becomes current object */ \ goto down; /* and descent */ \ }} #define up_lrecord() \ - { dies = objectplus(vorg,-(soint)offsetofa(record_,recdata)<<(oint_addr_shift-addr_shift)); /* Lrecord becomes current object */ \ - vorg = vorvorg; goto up; /* go further up */ \ + { curr = objectplus(pred,-(soint)offsetofa(record_,recdata)<<(oint_addr_shift-addr_shift)); /* Lrecord becomes current object */ \ + pred = prepred; goto up; /* go further up */ \ } #define down_sxrecord() \ - if (in_old_generation(dies,typecode(dies),0)) \ + if (in_old_generation(curr,typecode(curr),0)) \ goto up; /* do not mark older generation */ \ - { var gcv_object_t* dies_ = (gcv_object_t*)TheRecord(dies); \ - if (marked(dies_)) goto up; /* marked -> up */ \ - MARK(dies_); /* marked */ \ + { var gcv_object_t* curr_ = (gcv_object_t*)TheRecord(curr); \ + if (marked(curr_)) goto up; /* marked -> up */ \ + MARK(curr_); /* marked */ \ } \ - { var uintL len = SXrecord_nonweak_length(dies); \ + { var uintL len = SXrecord_nonweak_length(curr); \ if (len==0) goto up; /* Length 0: up again */ \ - {var object dies_ = objectplus(dies,((soint)offsetofa(record_,recdata) << (oint_addr_shift-addr_shift)) \ + {var object curr_ = objectplus(curr,((soint)offsetofa(record_,recdata) << (oint_addr_shift-addr_shift)) \ /* the "<< 1" and "/2" are a workaround against a gcc-2.7.2 \ missed optimization in WIDE_SOFT mode */ \ + (((soint)len << 1) * (soint)(sizeof(gcv_object_t)/2) << (oint_addr_shift-addr_shift)) \ - - ((soint)sizeof(gcv_object_t) << (oint_addr_shift-addr_shift)) ); \ + - ((soint)sizeof(gcv_object_t) << (oint_addr_shift-addr_shift)) );\ /* start with the last pointer */ \ - var object nachf = *(gcv_object_t*)TheRecord(dies_); /* successor */ \ - *(gcv_object_t*)TheRecord(dies_) = vorg; /* store predecessor */ \ - mark(&TheRecord(dies)->recdata[0]); /* mark first pointer */ \ - vorg = dies_; /* current object becomes new predecessor */ \ - dies = nachf; /* predecessor becomes current object */ \ + var object succ = *(gcv_object_t*)TheRecord(curr_); /* successor */ \ + *(gcv_object_t*)TheRecord(curr_) = pred; /* store predecessor */ \ + mark(&TheRecord(curr)->recdata[0]); /* mark first pointer */ \ + pred = curr_; /* current object becomes new predecessor */ \ + curr = succ; /* predecessor becomes current object */ \ goto down; /* and descent */ \ }} #define up_sxrecord() \ - { dies = objectplus(vorg,-(soint)offsetofa(record_,recdata)<<(oint_addr_shift-addr_shift)); /* record becomes current object */ \ - vorg = vorvorg; goto up; /* go further up */ \ + { curr = objectplus(pred,-(soint)offsetofa(record_,recdata)<<(oint_addr_shift-addr_shift)); /* record becomes current object */ \ + pred = prepred; goto up; /* go further up */ \ } #ifdef STANDARD_HEAPCODES #define down_subr() \ - if (in_old_generation(dies,typecode(dies),0)) \ + if (in_old_generation(curr,typecode(curr),0)) \ goto up; /* do not mark older generation */ \ - { var gcv_object_t* dies_ = (gcv_object_t*)TheSubr(dies); \ - if (marked(dies_)) goto up; /* marked -> up */ \ - MARK(dies_); /* marked */ \ + { var gcv_object_t* curr_ = (gcv_object_t*)TheSubr(curr); \ + if (marked(curr_)) goto up; /* marked -> up */ \ + MARK(curr_); /* marked */ \ } \ - { var object dies_ = objectplus(dies,((soint)offsetofa(record_,recdata) << (oint_addr_shift-addr_shift)) \ + { var object curr_ = objectplus(curr,((soint)offsetofa(record_,recdata) << (oint_addr_shift-addr_shift)) \ + ((soint)subr_length * (soint)sizeof(gcv_object_t) << (oint_addr_shift-addr_shift)) \ - ((soint)sizeof(gcv_object_t) << (oint_addr_shift-addr_shift)) ); \ /* start with the last pointer */ \ - var object nachf = *(gcv_object_t*)TheSubr(dies_); /* successor */ \ - *(gcv_object_t*)TheSubr(dies_) = vorg; /* store predecessor */ \ - mark(&((Record)TheSubr(dies))->recdata[0]); /* mark first pointer */ \ - vorg = dies_; /* current object becomes new predecessor */ \ - dies = nachf; /* predecessor becomes current object */ \ + var object succ = *(gcv_object_t*)TheSubr(curr_); /* successor */ \ + *(gcv_object_t*)TheSubr(curr_) = pred; /* store predecessor */ \ + mark(&((Record)TheSubr(curr))->recdata[0]); /* mark first pointer */ \ + pred = curr_; /* current object becomes new predecessor */ \ + curr = succ; /* predecessor becomes current object */ \ goto down; /* and descent */ \ } #define up_subr() \ - { dies = objectplus(vorg,-(soint)offsetofa(record_,recdata)<<(oint_addr_shift-addr_shift)); /* SUBR becomes current object */ \ - vorg = vorvorg; goto up; /* go further up */ \ + { curr = objectplus(pred,-(soint)offsetofa(record_,recdata)<<(oint_addr_shift-addr_shift)); /* SUBR becomes current object */ \ + pred = prepred; goto up; /* go further up */ \ } #endif down: /* entry for further descent. - dies = object to be marked (engl. this), - vorg = its predecessor */ - IF_DEBUG_GC_MARK(fprintf(stderr,"down: vorg = 0x%"PRIoint"x, dies = 0x%"PRIoint"x\n", - as_oint(vorg), as_oint(dies))); + curr = object to be marked (engl. this), + pred = its predecessor */ + IF_DEBUG_GC_MARK(fprintf(stderr,"down: pred = 0x%"PRIoint"x, curr = 0x%"PRIoint"x\n", + as_oint(pred), as_oint(curr))); #ifdef TYPECODES - switch (typecode(dies)) { + switch (typecode(curr)) { case_pair: /* object with exactly two 2 pointers (Cons and similar) */ down_pair(); case_symbol: /* Symbol */ down_varobject(TheSymbol,symbol_objects_offset, sizeof(symbol_)-sizeof(gcv_object_t)); case_sstring: /* simple-string */ - if (sstring_reallocatedp(TheSstring(dies))) { + if (sstring_reallocatedp(TheSstring(curr))) { down_sistring(); } /*FALLTHROUGH*/ @@ -250,15 +250,15 @@ /*NOTREACHED*/ abort(); } #else - switch (as_oint(dies) & nonimmediate_heapcode_mask) { + switch (as_oint(curr) & nonimmediate_heapcode_mask) { case cons_bias+conses_misaligned: /* cons */ #ifdef STANDARD_HEAPCODES /* NB: (immediate_bias & nonimmediate_heapcode_mask) == cons_bias. */ - if (immediate_object_p(dies)) goto up; + if (immediate_object_p(curr)) goto up; #endif down_pair(); case varobject_bias+varobjects_misaligned: - switch (Record_type(dies)) { + switch (Record_type(curr)) { case Rectype_Sbvector: case Rectype_Sb2vector: case Rectype_Sb4vector: @@ -321,35 +321,35 @@ } #endif up: /* entry for ascent. - dies = currently marked object, vorg = its predecessor */ - IF_DEBUG_GC_MARK(fprintf(stderr,"up: vorg = 0x%"PRIoint"x, dies = 0x%"PRIoint"x\n", - as_oint(vorg), as_oint(dies))); - if (eq(vorg,nullobj)) /* ending flag reached? */ + curr = currently marked object, pred = its predecessor */ + IF_DEBUG_GC_MARK(fprintf(stderr,"up: pred = 0x%"PRIoint"x, curr = 0x%"PRIoint"x\n", + as_oint(pred), as_oint(curr))); + if (eq(pred,nullobj)) /* ending flag reached? */ return; /* yes -> finished */ - if (!marked(ThePointer(vorg))) { /* already through? */ + if (!marked(ThePointer(pred))) { /* already through? */ /* no -> next element further left (come from 'up', go to 'down') - dies = currently marked object, store in *vorg */ - var object vorvorg = *(gcv_object_t*)ThePointer(vorg); /* old predecessor */ - *(gcv_object_t*)ThePointer(vorg) = dies; /* write back component */ - vorg = objectplus(vorg,-(soint)(sizeof(gcv_object_t))<<(oint_addr_shift-addr_shift)); /* go to next component */ - if (marked(ThePointer(vorg))) { /* already marked? */ - dies = /* next component, without mark */ - without_mark_bit(*(gcv_object_t*)ThePointer(vorg)); - *(gcv_object_t*)ThePointer(vorg) = /* further relocate old predecessor, thereby renew mark */ - with_mark_bit(vorvorg); + curr = currently marked object, store in *pred */ + var object prepred = *(gcv_object_t*)ThePointer(pred); /* old predecessor */ + *(gcv_object_t*)ThePointer(pred) = curr; /* write back component */ + pred = objectplus(pred,-(soint)(sizeof(gcv_object_t))<<(oint_addr_shift-addr_shift)); /* go to next component */ + if (marked(ThePointer(pred))) { /* already marked? */ + curr = /* next component, without mark */ + without_mark_bit(*(gcv_object_t*)ThePointer(pred)); + *(gcv_object_t*)ThePointer(pred) = /* further relocate old predecessor, thereby renew mark */ + with_mark_bit(prepred); } else { - dies = *(gcv_object_t*)ThePointer(vorg); /* next component, without mark */ - *(gcv_object_t*)ThePointer(vorg) = vorvorg; /* further relocate old predecessor */ + curr = *(gcv_object_t*)ThePointer(pred); /* next component, without mark */ + *(gcv_object_t*)ThePointer(pred) = prepred; /* further relocate old predecessor */ } goto down; } { /* already through -> ascent again */ - var object vorvorg = /* fetch old predecessor, without mark bit */ - without_mark_bit(*(gcv_object_t*)ThePointer(vorg)); - *(gcv_object_t*)ThePointer(vorg) = dies; /* write back first component */ + var object prepred = /* fetch old predecessor, without mark bit */ + without_mark_bit(*(gcv_object_t*)ThePointer(pred)); + *(gcv_object_t*)ThePointer(pred) = curr; /* write back first component */ #ifdef TYPECODES - switch (typecode(vorg)) { + switch (typecode(pred)) { case_pair: /* object with exactly two pointers (Cons and similar) */ up_pair(); case_symbol: /* Symbol */ @@ -367,8 +367,8 @@ case_subr: /* SUBR */ up_sxrecord(); case_sstring: /* simple-string */ - { var object vorg_ = objectplus(vorg,-(soint)sistring_data_offset<<(oint_addr_shift-addr_shift)); - if (sstring_reallocatedp(TheSstring(vorg_))) + { var object pred_ = objectplus(pred,-(soint)sistring_data_offset<<(oint_addr_shift-addr_shift)); + if (sstring_reallocatedp(TheSstring(pred_))) up_sistring(); } /*FALLTHROUGH*/ @@ -398,7 +398,7 @@ /*NOTREACHED*/ abort(); } #else - switch (as_oint(vorg) & nonimmediate_heapcode_mask) { + switch (as_oint(pred) & nonimmediate_heapcode_mask) { case cons_bias+conses_misaligned: /* Cons */ up_pair(); case varobject_bias+varobjects_misaligned: Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.5813 retrieving revision 1.5814 diff -u -d -r1.5813 -r1.5814 --- ChangeLog 4 Dec 2007 15:50:34 -0000 1.5813 +++ ChangeLog 4 Dec 2007 16:20:34 -0000 1.5814 @@ -1,13 +1,24 @@ -2007-12-03 Reini Urban <ru...@x-...> +2007-12-03 Reini Urban <ru...@x-...> + <19_gcmark_vars> + * spvw_gcmark.d: translate local variables: + (dies): curr + (dies_): curr_ + (nachf): succ + (vorg): pred + (vorvorg): prepred <18_test_index_macro> - * charstrg.d (test_index): englishify the macro arguments + * charstrg.d (test_index): translate the macro arguments: + (woher): from + (wohin_zuweisung): to_setter + (grenze): upper_limit + (vergleich): uplimit_cmp <17_liststern> - * bytecode.d, constsym.d, eval.d, foreign.d, list.d, stream.d, subr.d: + * bytecode.d, constsym.d, eval.d, foreign.d, list.d, stream.d, subr.d: (liststern): rename to liststar - * bytecode.d, eval.d (cod_unliststern): rename to cod_unliststar + * bytecode.d, eval.d (cod_unliststern): rename to cod_unliststar (cod_liststern_push): rename bytecode to cod_liststar_push (LIST*&PUSH) - * eval.d: rename label unliststern_unbound to unliststar_unbound + * eval.d: rename label unliststern_unbound to unliststar_unbound 2007-12-03 Sam Steingold <sd...@gn...> ------------------------------ ------------------------------------------------------------------------- SF.Net email is sponsored by: The Future of Linux Business White Paper from Novell. From the desktop to the data center, Linux is going mainstream. Let it simplify your IT future. http://altfarm.mediaplex.com/ad/ck/8857-50307-18918-4 ------------------------------ _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest, Vol 20, Issue 5 **************************************** |