From: <cli...@li...> - 2007-12-14 15:42:17
|
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 CodingStyle,1.21,1.22 ChangeLog,1.5842,1.5843 (Sam Steingold) 2. clisp/src realelem.d, 1.35, 1.36 compelem.d, 1.15, 1.16 ChangeLog, 1.5843, 1.5844 (Sam Steingold) 3. clisp/src compelem.d,1.16,1.17 ChangeLog,1.5844,1.5845 (Sam Steingold) 4. clisp/src spvw_circ.d,1.36,1.37 ChangeLog,1.5845,1.5846 (Sam Steingold) 5. clisp/src eval.d,1.229,1.230 (Sam Steingold) 6. clisp/src predtype.d, 1.139, 1.140 pathname.d, 1.407, 1.408 lispbibl.d, 1.747, 1.748 io.d, 1.319, 1.320 intprint.d, 1.9, 1.10 hashtabl.d, 1.134, 1.135 eval.d, 1.230, 1.231 debug.d, 1.101, 1.102 control.d, 1.143, 1.144 avl.d, 1.12, 1.13 ChangeLog, 1.5846, 1.5847 (Sam Steingold) ---------------------------------------------------------------------- Message: 1 Date: Thu, 13 Dec 2007 22:28:23 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src CodingStyle,1.21,1.22 ChangeLog,1.5842,1.5843 To: cli...@li... Message-ID: <E1J...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv28381/src Modified Files: CodingStyle ChangeLog Log Message: (elif, loop, until): drop; update all D files Index: CodingStyle =================================================================== RCS file: /cvsroot/clisp/clisp/src/CodingStyle,v retrieving revision 1.21 retrieving revision 1.22 diff -u -d -r1.21 -r1.22 --- CodingStyle 26 Nov 2007 16:42:10 -0000 1.21 +++ CodingStyle 13 Dec 2007 22:28:19 -0000 1.22 @@ -104,12 +104,6 @@ the code; it also allows you to mix declarations and statements freely, without the need for additional braces. -We have a few macros defined in lispbibl.d: 'elif' means 'else if', -'until' means 'while not' (both are now deprecated). -'loop' introduces a loop which can be exited only via 'break'; it's -equivalent to 'for(;;)'. It is deprecated as well. Use 'for (;;)', -not 'while (1)', instead. - C indentation ------------- Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.5842 retrieving revision 1.5843 diff -u -d -r1.5842 -r1.5843 --- ChangeLog 13 Dec 2007 20:58:09 -0000 1.5842 +++ ChangeLog 13 Dec 2007 22:28:19 -0000 1.5843 @@ -1,3 +1,7 @@ +2007-12-13 Sam Steingold <sd...@gn...> + + * lispbibl.d (elif, loop, until): drop; update all D files + 2007-12-12 Sam Steingold <sd...@gn...> * spvw_typealloc.d (NIL_FILL): add ------------------------------ Message: 2 Date: Thu, 13 Dec 2007 22:33:36 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src realelem.d, 1.35, 1.36 compelem.d, 1.15, 1.16 ChangeLog, 1.5843, 1.5844 To: cli...@li... Message-ID: <E1J...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv30690/src Modified Files: realelem.d compelem.d ChangeLog Log Message: (I_I_equal, R_R_equal): renamed from _gleich Index: compelem.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/compelem.d,v retrieving revision 1.15 retrieving revision 1.16 diff -u -d -r1.15 -r1.16 --- compelem.d 2 Dec 2007 17:06:28 -0000 1.15 +++ compelem.d 13 Dec 2007 22:33:32 -0000 1.16 @@ -863,12 +863,12 @@ # x reell if (N_realp(y)) { # x,y beide reell - return R_R_gleich(x,y); + return R_R_equal(x,y); } else { # x reell, y komplex if (!R_zerop(TheComplex(y)->c_imag)) return false; - return R_R_gleich(x,TheComplex(y)->c_real); + return R_R_equal(x,TheComplex(y)->c_real); } } else { # x komplex @@ -876,12 +876,12 @@ # x komplex, y reell if (!R_zerop(TheComplex(x)->c_imag)) return false; - return R_R_gleich(TheComplex(x)->c_real,y); + return R_R_equal(TheComplex(x)->c_real,y); } else { # x,y beide komplex - if (!R_R_gleich(TheComplex(x)->c_real,TheComplex(y)->c_real)) # Realteile vergleichen + if (!R_R_equal(TheComplex(x)->c_real,TheComplex(y)->c_real)) # Realteile vergleichen return false; - if (!R_R_gleich(TheComplex(x)->c_imag,TheComplex(y)->c_imag)) # Imaginärteile vergleichen + if (!R_R_equal(TheComplex(x)->c_imag,TheComplex(y)->c_imag)) # Imaginärteile vergleichen return false; return true; } Index: realelem.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/realelem.d,v retrieving revision 1.35 retrieving revision 1.36 diff -u -d -r1.35 -r1.36 --- realelem.d 28 Nov 2007 16:25:32 -0000 1.35 +++ realelem.d 13 Dec 2007 22:33:32 -0000 1.36 @@ -727,7 +727,7 @@ } } -/* R_R_gleich(x,y) compares two real numbers x and y. +/* R_R_equal(x,y) compares two real numbers x and y. result: true if x=y, else false. method: When are x and y equal? According to CLTL, 2nd ed., p. 290 the @@ -745,9 +745,9 @@ test for equality of two integers: either both are EQ or both are Bignums of same length and same digits (including sign). returns wit false_statement, if not equal. - #define I_I_gleich(x,y) (eq(x,y) || (I_bignump(x) && I_bignump(y) && (x_len==y_len) && (compare_loop_up(x_data,y_data)==0))) + #define I_I_equal(x,y) (eq(x,y) || (I_bignump(x) && I_bignump(y) && (x_len==y_len) && (compare_loop_up(x_data,y_data)==0))) */ -#define I_I_gleich(x_,y_,false_statement) \ +#define I_I_equal(x_,y_,false_statement) \ { var object _x = (x_); \ var object _y = (y_); \ if (!eq(_x,_y)) { \ @@ -759,22 +759,22 @@ &TheBignum(_y)->data[0],xlen)!=0) \ { false_statement } \ }}} -local bool R_R_gleich (object x, object y) +local bool R_R_equal (object x, object y) { if (R_rationalp(x)) { /* x rational */ if (R_rationalp(y)) { /* x,y both rational */ if (RA_integerp(x)) { if (!RA_integerp(y)) return false; /* x,y both integers */ - I_I_gleich(x,y, { return false; } ); + I_I_equal(x,y, { return false; } ); return true; } else { if (RA_integerp(y)) return false; /* x,y both ratio */ /* compare denominators: */ - I_I_gleich(TheRatio(x)->rt_den,TheRatio(y)->rt_den, {return false;} ); + I_I_equal(TheRatio(x)->rt_den,TheRatio(y)->rt_den, {return false;} ); /* compare numerators: */ - I_I_gleich(TheRatio(x)->rt_num,TheRatio(y)->rt_num, {return false;} ); + I_I_equal(TheRatio(x)->rt_num,TheRatio(y)->rt_num, {return false;} ); return true; } } else /* x rational, y float */ Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.5843 retrieving revision 1.5844 diff -u -d -r1.5843 -r1.5844 --- ChangeLog 13 Dec 2007 22:28:19 -0000 1.5843 +++ ChangeLog 13 Dec 2007 22:33:32 -0000 1.5844 @@ -1,6 +1,7 @@ 2007-12-13 Sam Steingold <sd...@gn...> * lispbibl.d (elif, loop, until): drop; update all D files + * compelem.d, realelem.d (I_I_equal, R_R_equal): renamed from _gleich 2007-12-12 Sam Steingold <sd...@gn...> ------------------------------ Message: 3 Date: Thu, 13 Dec 2007 22:39:01 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src compelem.d,1.16,1.17 ChangeLog,1.5844,1.5845 To: cli...@li... Message-ID: <E1J...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv772/src Modified Files: compelem.d ChangeLog Log Message: (N_N_equal): rewrote as a single return Index: compelem.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/compelem.d,v retrieving revision 1.16 retrieving revision 1.17 diff -u -d -r1.16 -r1.17 --- compelem.d 13 Dec 2007 22:33:32 -0000 1.16 +++ compelem.d 13 Dec 2007 22:38:58 -0000 1.17 @@ -852,39 +852,22 @@ /* N_N_equal(x,y) compares two real numbers x and y. Returns: true if x=y, false otherwise. */ global /* local */ bool N_N_equal (object x, object y); -# Methode: -# Falls beide reell, klar. -# Falls x reell, y komplex: (= x (realpart y)) und (zerop (imagpart y)). -# Falls x komplex, y reell: analog -# Falls beide komplex: Realteile und Imaginärteile jeweils gleich? +/* Method: + both real => R_R_equal + x real, y complex => (= x (realpart y)) && (zerop (imagpart y)) + x complex, y real => (= y (realpart x)) && (zerop (imagpart x)) + both complex: realpart & imagpart both equal */ global /* local */ bool N_N_equal (object x, object y) - { - if (N_realp(x)) { - # x reell - if (N_realp(y)) { - # x,y beide reell - return R_R_equal(x,y); - } else { - # x reell, y komplex - if (!R_zerop(TheComplex(y)->c_imag)) - return false; - return R_R_equal(x,TheComplex(y)->c_real); - } - } else { - # x komplex - if (N_realp(y)) { - # x komplex, y reell - if (!R_zerop(TheComplex(x)->c_imag)) - return false; - return R_R_equal(TheComplex(x)->c_real,y); - } else { - # x,y beide komplex - if (!R_R_equal(TheComplex(x)->c_real,TheComplex(y)->c_real)) # Realteile vergleichen - return false; - if (!R_R_equal(TheComplex(x)->c_imag,TheComplex(y)->c_imag)) # Imaginärteile vergleichen - return false; - return true; - } - } - } - +{ + return N_realp(x) + ? (N_realp(y) + ? /* x,y both real */ R_R_equal(x,y) + : /* x real, y complex */ (R_zerop(TheComplex(y)->c_imag) + ? R_R_equal(x,TheComplex(y)->c_real) : false)) + : (N_realp(y) + ? /* x complex, y real */ (R_zerop(TheComplex(x)->c_imag) + ? R_R_equal(TheComplex(x)->c_real,y) : false) + : /* x,y both complex */ + (R_R_equal(TheComplex(x)->c_real,TheComplex(y)->c_real) + ? R_R_equal(TheComplex(x)->c_imag,TheComplex(y)->c_imag) : false)); +} Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.5844 retrieving revision 1.5845 diff -u -d -r1.5844 -r1.5845 --- ChangeLog 13 Dec 2007 22:33:32 -0000 1.5844 +++ ChangeLog 13 Dec 2007 22:38:58 -0000 1.5845 @@ -2,6 +2,7 @@ * lispbibl.d (elif, loop, until): drop; update all D files * compelem.d, realelem.d (I_I_equal, R_R_equal): renamed from _gleich + * compelem.d (N_N_equal): rewrote as a single return 2007-12-12 Sam Steingold <sd...@gn...> ------------------------------ Message: 4 Date: Thu, 13 Dec 2007 22:43:52 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src spvw_circ.d,1.36,1.37 ChangeLog,1.5845,1.5846 To: cli...@li... Message-ID: <E1J...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv2750/src Modified Files: spvw_circ.d ChangeLog Log Message: (abort_context, abort_STACK): renamed from abbruch_* Index: spvw_circ.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/spvw_circ.d,v retrieving revision 1.36 retrieving revision 1.37 diff -u -d -r1.36 -r1.37 --- spvw_circ.d 13 Dec 2007 21:24:30 -0000 1.36 +++ spvw_circ.d 13 Dec 2007 22:43:50 -0000 1.37 @@ -390,8 +390,8 @@ bool pr_array; bool pr_closure; uintL counter; - jmp_buf abbruch_context; - gcv_object_t* abbruch_STACK; + jmp_buf abort_context; + gcv_object_t* abort_STACK; } get_circ_global; /* UP: marks the object obj, pushes occurring circularities on the STACK @@ -418,9 +418,9 @@ { var object obj_cdr = Cdr(obj); /* components */ var object obj_car = Car(obj); - if (SP_overflow()) /* check SP-depth */ - longjmp(env->abbruch_context,true); /* abort */ - get_circ_mark(obj_car,env); /* mark CAR (recursive) */ + if (SP_overflow()) /* check SP-depth */ + longjmp(env->abort_context,true); /* abort */ + get_circ_mark(obj_car,env); /* mark CAR (recursive) */ obj = obj_cdr; goto entry; /* mark CDR (tail-end-recursive) */ } case_symbol: @@ -458,8 +458,8 @@ if (!(count==0)) { /* mark count>0 components */ var gcv_object_t* ptr = &TheSvector(obj)->data[0]; - if (SP_overflow()) /* check SP-depth */ - longjmp(env->abbruch_context,true); /* abort */ + if (SP_overflow()) /* check SP-depth */ + longjmp(env->abort_context,true); /* abort */ dotimespL(count,count, { get_circ_mark(*ptr++,env); } ); /* mark components (recursive) */ } } @@ -564,8 +564,8 @@ var uintL count = Lrecord_length(obj)-2; if (count > 0) { var gcv_object_t* ptr = &TheWeakList(obj)->wl_elements[0]; - if (SP_overflow()) /* check SP-depth */ - longjmp(env->abbruch_context,true); /* abort */ + if (SP_overflow()) /* check SP-depth */ + longjmp(env->abort_context,true); /* abort */ dotimespL(count,count, { get_circ_mark(*ptr++,env); } ); /* mark elements (recursive) */ } } @@ -596,8 +596,8 @@ var uintL count = Lrecord_length(obj)-1; /* don't mark wp_cdr */ /* mark count>0 components, starting from recdata[1] */ var gcv_object_t* ptr = &TheLrecord(obj)->recdata[1]; - if (SP_overflow()) /* check SP-depth */ - longjmp(env->abbruch_context,true); /* abort */ + if (SP_overflow()) /* check SP-depth */ + longjmp(env->abort_context,true); /* abort */ dotimespL(count,count, { get_circ_mark(*ptr++,env); } ); /* mark components (recursive) */ } goto m_end; @@ -612,8 +612,8 @@ if (!(count==0)) { /* mark count>0 components */ var gcv_object_t* ptr = &TheRecord(obj)->recdata[0]; - if (SP_overflow()) /* check SP-depth */ - longjmp(env->abbruch_context,true); /* abort */ + if (SP_overflow()) /* check SP-depth */ + longjmp(env->abort_context,true); /* abort */ dotimespC(count,count, { get_circ_mark(*ptr++,env); } ); /* mark components (recursive) */ } } @@ -622,7 +622,7 @@ /* object was marked, but has already been marked. It is a circularity. */ if (STACK_overflow()) /* check STACK-depth */ - longjmp(env->abbruch_context,true); /* abort */ + longjmp(env->abort_context,true); /* abort */ /* store object in STACK: */ pushSTACK(obj); env->counter++; /* and count */ @@ -650,13 +650,13 @@ var get_circ_global my_global; /* counter and context (incl. STACK-value) */ /* for the case of an abort */ set_break_sem_1(); /* make Break impossible */ - if (!setjmp(my_global.abbruch_context)) { /* save context */ - bcopy(my_global.abbruch_context,my_global.bitmap.oom_context,sizeof(jmp_buf)); + if (!setjmp(my_global.abort_context)) { /* save context */ + bcopy(my_global.abort_context,my_global.bitmap.oom_context,sizeof(jmp_buf)); mlb_alloc(&my_global.bitmap); /* allocate bitmap */ my_global.pr_array = pr_array; my_global.pr_closure = pr_closure; my_global.counter = 0; /* counter := 0 */ - my_global.abbruch_STACK = STACK; + my_global.abort_STACK = STACK; /* the context-backup my_global is now ready. */ get_circ_mark(obj,&my_global); /* mark object, push multiple */ /* structures on the STACK count in my_global.counter */ @@ -676,7 +676,7 @@ } } else { /* after abort because of SP- or STACK-overflow */ - setSTACK(STACK = my_global.abbruch_STACK); /* reset STACK again */ + setSTACK(STACK = my_global.abort_STACK); /* reset STACK again */ /* the context is now reestablished. */ mlb_free(&my_global.bitmap); /* free Bitmap */ clr_break_sem_1(); /* Break again possible */ @@ -696,8 +696,8 @@ bool pr_array; bool pr_closure; uintL counter; - jmp_buf abbruch_context; - gcv_object_t* abbruch_STACK; + jmp_buf abort_context; + gcv_object_t* abort_STACK; } get_circ_global; /* It has to be accessed from within the two local routines. */ local void get_circ_mark (object obj, get_circ_global* env); @@ -707,11 +707,11 @@ var get_circ_global my_global; /* counter and context (incl. STACK-value) */ /* in case of an abort */ set_break_sem_1(); /* make Break impossible */ - if (!setjmp(my_global.abbruch_context)) { /* save context */ + if (!setjmp(my_global.abort_context)) { /* save context */ my_global.pr_array = pr_array; my_global.pr_closure = pr_closure; my_global.counter = 0; /* counter := 0 */ - my_global.abbruch_STACK = STACK; + my_global.abort_STACK = STACK; /* the context-backup my_global is now ready. */ get_circ_mark(obj,&my_global); /* mark object, push multiple */ /* structures on the STACK count in my_global.counter */ @@ -731,7 +731,7 @@ } } else { /* after abort because of SP- or STACK-overflow */ - setSTACK(STACK = my_global.abbruch_STACK); /* reset STACK again */ + setSTACK(STACK = my_global.abort_STACK); /* reset STACK again */ /* the context is now reestablished. */ get_circ_unmark(obj,&my_global); /* delete marks again */ clr_break_sem_1(); /* Break is possible again */ @@ -762,10 +762,10 @@ { var object obj_cdr = Cdr(obj); /* components (without mark bit) */ var object obj_car = Car(obj); - mark(TheCons(obj)); /* mark */ - if (SP_overflow()) /* check SP-depth */ - longjmp(env->abbruch_context,true); /* abort */ - get_circ_mark(obj_car,env); /* mark CAR (recursive) */ + mark(TheCons(obj)); /* mark */ + if (SP_overflow()) /* check SP-depth */ + longjmp(env->abort_context,true); /* abort */ + get_circ_mark(obj_car,env); /* mark CAR (recursive) */ obj = obj_cdr; goto entry; /* mark CDR (tail-end-recursive) */ } case_symbol: @@ -810,8 +810,8 @@ if (!(count==0)) { /* mark count>0 components */ var gcv_object_t* ptr = &TheSvector(obj)->data[0]; - if (SP_overflow()) /* check SP-depth */ - longjmp(env->abbruch_context,true); /* abort */ + if (SP_overflow()) /* check SP-depth */ + longjmp(env->abort_context,true); /* abort */ dotimespL(count,count, { get_circ_mark(*ptr++,env); } ); /* mark components (recursive) */ } } @@ -923,8 +923,8 @@ var uintL count = Lrecord_length(obj)-2; if (count > 0) { var gcv_object_t* ptr = &TheWeakList(obj)->wl_elements[0]; - if (SP_overflow()) /* check SP-depth */ - longjmp(env->abbruch_context,true); /* abort */ + if (SP_overflow()) /* check SP-depth */ + longjmp(env->abort_context,true); /* abort */ dotimespL(count,count, { get_circ_mark(*ptr++,env); } ); /* mark elements (recursive) */ } } @@ -955,8 +955,8 @@ var uintL count = Lrecord_length(obj)-1; /* don't mark wp_cdr */ /* mark count>0 components, starting from recdata[1] */ var gcv_object_t* ptr = &TheLrecord(obj)->recdata[1]; - if (SP_overflow()) /* check SP-depth */ - longjmp(env->abbruch_context,true); /* abort */ + if (SP_overflow()) /* check SP-depth */ + longjmp(env->abort_context,true); /* abort */ dotimespL(count,count, { get_circ_mark(*ptr++,env); } ); /* mark components (recursive) */ } goto m_end; @@ -971,8 +971,8 @@ if (!(count==0)) { /* mark count>0 components */ var gcv_object_t* ptr = &TheRecord(obj)->recdata[0]; - if (SP_overflow()) /* check SP-depth */ - longjmp(env->abbruch_context,true); /* abort */ + if (SP_overflow()) /* check SP-depth */ + longjmp(env->abort_context,true); /* abort */ dotimespC(count,count, { get_circ_mark(*ptr++,env); } ); /* mark components (recursive) */ } } @@ -981,7 +981,7 @@ /* Object has been marked, but was already marked. It is a circularity. */ if (STACK_overflow()) /* check STACK-depth */ - longjmp(env->abbruch_context,true); /* abort */ + longjmp(env->abort_context,true); /* abort */ /* store object with deleted garcol_bit in STACK: */ pushSTACK(without_mark_bit(obj)); env->counter++; /* and count */ @@ -1232,7 +1232,7 @@ typedef struct { mlbitmap bitmap; object alist; - jmp_buf abbruch_context; + jmp_buf abort_context; object bad; } subst_circ_global; @@ -1240,7 +1240,7 @@ { #if !(defined(NO_SP_CHECK) || defined(NOCOST_SP_CHECK)) if (SP_overflow()) { /* check SP-depth */ - env->bad = nullobj; longjmp(env->abbruch_context,true); /* abort */ + env->bad = nullobj; longjmp(env->abort_context,true); /* abort */ } #endif enter_subst: @@ -1330,7 +1330,7 @@ } /* not found -> abort */ env->bad = obj; - longjmp(env->abbruch_context,true); + longjmp(env->abort_context,true); } if (mlb_add(&env->bitmap,obj)) /* object already marked? */ return; @@ -1374,7 +1374,7 @@ } /* not found -> abort */ env->bad = obj; - longjmp(env->abbruch_context,true); + longjmp(env->abort_context,true); } return; case_cons: /* Cons */ @@ -1408,8 +1408,8 @@ var subst_circ_global my_global; my_global.alist = alist; set_break_sem_1(); /* disable Break */ - if (!setjmp(my_global.abbruch_context)) { - bcopy(my_global.abbruch_context,my_global.bitmap.oom_context,sizeof(jmp_buf)); + if (!setjmp(my_global.abort_context)) { + bcopy(my_global.abort_context,my_global.bitmap.oom_context,sizeof(jmp_buf)); mlb_alloc(&my_global.bitmap); subst_circ_mark(ptr,&my_global); /* mark and substitute */ mlb_free(&my_global.bitmap); Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.5845 retrieving revision 1.5846 diff -u -d -r1.5845 -r1.5846 --- ChangeLog 13 Dec 2007 22:38:58 -0000 1.5845 +++ ChangeLog 13 Dec 2007 22:43:50 -0000 1.5846 @@ -1,8 +1,9 @@ 2007-12-13 Sam Steingold <sd...@gn...> * lispbibl.d (elif, loop, until): drop; update all D files - * compelem.d, realelem.d (I_I_equal, R_R_equal): renamed from _gleich + * compelem.d, realelem.d (I_I_equal, R_R_equal): renamed from *_gleich * compelem.d (N_N_equal): rewrote as a single return + * spvw_circ.d (abort_context, abort_STACK): renamed from abbruch_* 2007-12-12 Sam Steingold <sd...@gn...> ------------------------------ Message: 5 Date: Fri, 14 Dec 2007 15:28:34 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src eval.d,1.229,1.230 To: cli...@li... Message-ID: <E1J...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv31655/src Modified Files: eval.d Log Message: convert comments from "# " to "/**/" Index: eval.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/eval.d,v retrieving revision 1.229 retrieving revision 1.230 diff -u -d -r1.229 -r1.230 --- eval.d 13 Dec 2007 22:27:46 -0000 1.229 +++ eval.d 14 Dec 2007 15:28:32 -0000 1.230 @@ -6,7 +6,6 @@ */ #include "lispbibl.c" - /* function-table: In this table only SUBRS are listed, which may be inlined by the compiler. In FUNTAB1 and FUNTAB2 SUBRs without Rest-Parameter (i.e. with @@ -619,7 +618,7 @@ /* search for Catch-Frame with Tag = tag: */ var gcv_object_t* FRAME = STACK; while (1) { /* search in the Stack starting at FRAME [...11355 lines suppressed...] O(constant_initfunction_code) = codevec; } - # Build #12Y(00 00 00 00 00 00 00 00 11 16 1B 7E) ; L0 (JMP L0) + /* Build #12Y(00 00 00 00 00 00 00 00 11 16 1B 7E) ; L0 (JMP L0) */ { var object codevec = allocate_bit_vector(Atype_8Bit,CCV_START_NONKEY+2); TheCodevec(codevec)->ccv_spdepth_1 = 0; @@ -8620,8 +8215,8 @@ } -# where is check_SP() or check_STACK() to be inserted?? -# is nest_env supposed to receive its target-environment as parameter?? -# register-allocation in eval_subr and eval_cclosure etc.?? -# eliminate subr_self?? +/* where is check_SP() or check_STACK() to be inserted?? + is nest_env supposed to receive its target-environment as parameter?? + register-allocation in eval_subr and eval_cclosure etc.?? + eliminate subr_self?? */ ------------------------------ Message: 6 Date: Fri, 14 Dec 2007 15:42:04 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src predtype.d, 1.139, 1.140 pathname.d, 1.407, 1.408 lispbibl.d, 1.747, 1.748 io.d, 1.319, 1.320 intprint.d, 1.9, 1.10 hashtabl.d, 1.134, 1.135 eval.d, 1.230, 1.231 debug.d, 1.101, 1.102 control.d, 1.143, 1.144 avl.d, 1.12, 1.13 ChangeLog, 1.5846, 1.5847 To: cli...@li... Message-ID: <E1J...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv4206/src Modified Files: predtype.d pathname.d lispbibl.d io.d intprint.d hashtabl.d eval.d debug.d control.d avl.d ChangeLog Log Message: rename label fertig to done Index: pathname.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/pathname.d,v retrieving revision 1.407 retrieving revision 1.408 diff -u -d -r1.407 -r1.408 --- pathname.d 13 Dec 2007 22:27:45 -0000 1.407 +++ pathname.d 14 Dec 2007 15:41:55 -0000 1.408 @@ -1507,8 +1507,8 @@ var object thing = STACK_4; if (xpathnamep(thing)) { /* Pathname? */ value1 = thing; /* 1. value thing */ - fertig: - DOUT("parse-namestring:[fertig]",value1); + done: + DOUT("parse-namestring:[done]",value1); value2 = STACK_1; mv_count=2; /* 2. value start */ skipSTACK(5); return; } @@ -1516,7 +1516,7 @@ thing = as_file_stream(thing); test_file_stream_named(thing); value1 = TheStream(thing)->strm_file_name; /* 1. value: Filename */ - goto fertig; /* 2. value like above */ + goto done; /* 2. value like above */ } /* thing should now be at least a String or a Symbol: */ var bool thing_symbol = false; Index: avl.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/avl.d,v retrieving revision 1.12 retrieving revision 1.13 diff -u -d -r1.12 -r1.13 --- avl.d 13 Dec 2007 21:53:04 -0000 1.12 +++ avl.d 14 Dec 2007 15:41:59 -0000 1.13 @@ -311,14 +311,14 @@ while (1) { var NODE* node = *nodeplace; if (node == EMPTY) - goto fertig; /* element not found */ + goto done; /* element not found */ *stack_ptr++ = nodeplace; stack_count++; var SIGNED_INT sign = COMPARE(key,KEYOF(node->nodedata.value)); if (sign == 0) { if (EQUAL(value,node->nodedata.value)) { /* found? */ node_to_delete = node; break; } else - goto fertig; + goto done; } if (sign < 0) /* key < KEYOF(node->nodedata.value) --> remove in left subtree: */ @@ -358,7 +358,7 @@ } FREE(node_to_delete); AVL(AVLID,rebalance)(stack_ptr,stack_count); - fertig: + done: return tree; } #endif @@ -408,7 +408,7 @@ while (1) { var NODE* node = *nodeplace; if (node == EMPTY) - goto fertig; /* element not found */ + goto done; /* element not found */ *stack_ptr++ = nodeplace; stack_count++; var SIGNED_INT sign = COMPARE(key,KEYOF(node->nodedata.value)); if (sign == 0) { @@ -420,7 +420,7 @@ nodeplace = stack_ptr[-1]; break; } else - goto fertig; /* not found */ + goto done; /* not found */ } if (sign < 0) /* key < KEYOF(node->nodedata.value) --> remove in left subtree: */ @@ -462,7 +462,7 @@ } } AVL(AVLID,rebalance)(stack_ptr,stack_count); - fertig: + done: return tree; } #endif Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.5846 retrieving revision 1.5847 diff -u -d -r1.5846 -r1.5847 --- ChangeLog 13 Dec 2007 22:43:50 -0000 1.5846 +++ ChangeLog 14 Dec 2007 15:41:59 -0000 1.5847 @@ -1,3 +1,8 @@ +2007-12-14 Sam Steingold <sd...@gn...> + + * avl.d, control.d, debug.d, eval.d, hashtabl.d, intprint.d, io.d: + * lispbibl.d, pathname.d, predtype.d: rename label fertig to done + 2007-12-13 Sam Steingold <sd...@gn...> * lispbibl.d (elif, loop, until): drop; update all D files Index: debug.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/debug.d,v retrieving revision 1.101 retrieving revision 1.102 diff -u -d -r1.101 -r1.102 --- debug.d 13 Dec 2007 22:27:47 -0000 1.101 +++ debug.d 14 Dec 2007 15:41:58 -0000 1.102 @@ -991,7 +991,7 @@ && (!eq(found_block_env,nullobj)) && (!eq(found_go_env,nullobj)) && (!eq(found_decl_env,nullobj))) - goto fertig; + goto done; } end: /* end of stack is reached. */ /* fetch the remaining environment-components from the current environment: */ @@ -1000,7 +1000,7 @@ if (eq(found_block_env,nullobj)) { found_block_env = aktenv.block_env; } if (eq(found_go_env,nullobj)) { found_go_env = aktenv.go_env; } if (eq(found_decl_env,nullobj)) { found_decl_env = aktenv.decl_env; } - fertig: + done: /* construct environment-frame: */ make_ENV5_frame(); /* set current environments: */ Index: eval.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/eval.d,v retrieving revision 1.230 retrieving revision 1.231 diff -u -d -r1.230 -r1.231 --- eval.d 14 Dec 2007 15:28:32 -0000 1.230 +++ eval.d 14 Dec 2007 15:41:58 -0000 1.231 @@ -424,7 +424,7 @@ callback_saved_registers = (struct registers *)(aint)as_oint(STACK_1); /* set STACK, thus unwind frame: */ setSTACK(STACK = new_STACK); - goto fertig; + goto done; } else #endif { @@ -449,7 +449,7 @@ } /* set STACK, thus unwind frame: */ setSTACK(STACK = new_STACK); - goto fertig; + goto done; } } } else { @@ -493,13 +493,13 @@ } /* set STACK, thus unwind frame: */ setSTACK(STACK = new_STACK); - goto fertig; + goto done; } } } /* set STACK, thus unwind frame: */ setSTACK(STACK = topofframe(STACK_0)); - fertig: ; + done: ; } /* UP: "unwinds" the STACK up to the next DRIVER_FRAME and @@ -942,7 +942,7 @@ var gcv_object_t* bindingsptr = &FRAME_(frame_bindings); /* pointer to the first binding */ dotimespL(count,count, { if (equal(*(bindingsptr STACKop 0),sym)) { /* right Symbol? */ - value = *(bindingsptr STACKop 1); goto fertig; + value = *(bindingsptr STACKop 1); goto done; } bindingsptr skipSTACKop 2; /* no: next binding */ }); @@ -961,7 +961,7 @@ value = *(ptr+1); if (from_inside_macrolet && !macrop(value)) goto macrolet_error; - goto fertig; + goto done; } ptr += 2; /* next binding */ }); @@ -984,7 +984,7 @@ return unbound; /* else undefined */ } return Symbol_function(sym); - fertig: + done: /* Symbol found active in Environment, "Value" value (a Closure or Macro or FunctionMacro or NIL) if Definition = NIL (during LABELS), the function is passed for as undefined: */ @@ -1478,13 +1478,13 @@ var object body_rest = Cdr(body); /* shorten body */ if (stringp(form)) { /* found Doc-String? */ if (atomp(body_rest)) /* at the last position of the form list? */ - goto fertig; /* yes -> last form can't be a Doc-String! */ + goto done; /* yes -> last form can't be a Doc-String! */ if (!nullp(STACK_1)) { /* preceding Doc-String? */ /* yes -> more than one Doc-String is too much: */ pushSTACK(STACK_2); /* SOURCE-PROGRAM-ERROR slot DETAIL */ pushSTACK(STACK_0); error(source_program_error, - GETTEXT("Too many documentation strings in ~S")); + GETTEXT("Too many documentation strings in ~S")); } STACK_1 = form; /* new Doc-String */ body = body_rest; @@ -1514,7 +1514,7 @@ skipSTACK(1); body = popSTACK(); /* body := old body_rest */ } else { - fertig: /* finished with loop over the form list */ + done: /* finished with loop over the form list */ break; } } Index: hashtabl.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/hashtabl.d,v retrieving revision 1.134 retrieving revision 1.135 diff -u -d -r1.134 -r1.135 --- hashtabl.d 13 Dec 2007 21:53:02 -0000 1.134 +++ hashtabl.d 14 Dec 2007 15:41:58 -0000 1.135 @@ -2730,14 +2730,14 @@ kvt_data + 3*index; if (equal_tuple(KVptr[0],argcount,rest_args_pointer)) { /* compare key */ /* found */ - VALUES1(KVptr[1]); goto fertig; /* Value as value */ + VALUES1(KVptr[1]); goto done; /* Value as value */ } Nptr = &KVptr[2]; /* pointer to index of next entry */ } } /* not found */ VALUES1(NIL); - fertig: + done: set_args_end_pointer(rest_args_pointer STACKop 1); /* clean up STACK */ } Index: predtype.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/predtype.d,v retrieving revision 1.139 retrieving revision 1.140 diff -u -d -r1.139 -r1.140 --- predtype.d 1 Dec 2007 23:26:41 -0000 1.139 +++ predtype.d 14 Dec 2007 15:41:55 -0000 1.140 @@ -1877,7 +1877,7 @@ while (consp(type)) { var object name = Car(type); var object clas = get(name,S(closclass)); /* (GET name 'CLOS::CLOSCLASS) */ - if_defined_class_p(clas, { value1 = clas; goto fertig; }, ; ); + if_defined_class_p(clas, { value1 = clas; goto done; }, ; ); type = Cdr(type); } } @@ -2033,9 +2033,10 @@ if_defined_class_p(value1, ; , { pushSTACK(value1); pushSTACK(S(class_of)); - error(error_condition,GETTEXT("~S: type ~S does not correspond to a class")); + error(error_condition, + GETTEXT("~S: type ~S does not correspond to a class")); }); - fertig: + done: mv_count=1; } Index: intprint.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/intprint.d,v retrieving revision 1.9 retrieving revision 1.10 diff -u -d -r1.9 -r1.10 --- intprint.d 13 Dec 2007 22:27:46 -0000 1.9 +++ intprint.d 14 Dec 2007 15:41:58 -0000 1.10 @@ -210,7 +210,7 @@ # normalisiere zu einer NUDS: while (1) { if (len==0) { # 0 -> eine Ziffer '0' - next_digit(0); goto fertig; + next_digit(0); goto done; } if (MSDptr[0]==0) { MSDptr++; len--; @@ -248,7 +248,7 @@ while (chareq(*erg_ptr,ascii('0'))) { erg_ptr++; } - fertig: + done: erg->MSBptr = erg_ptr; erg->len = erg->LSBptr - erg_ptr; end_arith_call(); Index: io.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/io.d,v retrieving revision 1.319 retrieving revision 1.320 diff -u -d -r1.319 -r1.320 --- io.d 13 Dec 2007 22:27:46 -0000 1.319 +++ io.d 14 Dec 2007 15:41:57 -0000 1.320 @@ -2779,7 +2779,7 @@ else if (eq(ch,ascii_char('#'))) { # sub-char and '#' has been read -> decrease depth: if (depth==0) - goto fertig; + goto done; depth--; goto loop1; } else @@ -2805,7 +2805,7 @@ pushSTACK(S(read)); error(end_of_file, GETTEXT("~S: input stream ~S ends within a comment #~C ... ~C#")); - fertig: + done: VALUES0; skipSTACK(2); /* return no values */ } @@ -6153,7 +6153,7 @@ break; write_ascii_char(stream_,' '); # print #\Space } - goto fertig; + goto done; gesamt_mehrzeiler: # a multi-liner, altogether. # print blocks apartly, separated by Newline, to the stream: pushSTACK(nreverse(Symbol_value(S(prin_jblocks)))); # (nreverse SYS::*PRIN-JBLOCKS*) @@ -6177,8 +6177,8 @@ TheStream(stream)->strm_pphelp_lpos = STACK_1; # GesamtModus := multi-liner: TheStream(stream)->strm_pphelp_modus = mehrzeiler; - goto fertig; - fertig: # line-position is now correct. + goto done; + done: /* line-position is now correct. */ skipSTACK(2); # forget empty remaining list and the old line-position # unbind bindings of JUSTIFY_START: dynamic_unbind(S(prin_jblocks)); Index: control.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/control.d,v retrieving revision 1.143 retrieving revision 1.144 diff -u -d -r1.143 -r1.144 --- control.d 13 Dec 2007 21:53:04 -0000 1.143 +++ control.d 14 Dec 2007 15:41:58 -0000 1.144 @@ -1421,7 +1421,7 @@ do { \ var gcv_object_t* next_list_ = &NEXT(argptr); \ var object next_list = *next_list_; \ - if (endp(next_list)) goto fertig; /* a list ended -> done */ \ + if (endp(next_list)) goto done; /* a list ended -> done */ \ pushSTACK(listaccess(next_list)); /* as argument on the stack */ \ *next_list_ = Cdr(next_list); /* shorten list */ \ } while (--count); \ @@ -1431,7 +1431,7 @@ Car(new_cons) = popSTACK(); Cdr(new_cons) = STACK_0; \ STACK_0 = new_cons; /* lengthen the result list */ \ }} \ - fertig: \ + done: \ VALUES1(nreverse(*ergptr)); /* reverse result list */ \ set_args_end_pointer(args_pointer); /* clean up STACK */ \ }} @@ -1455,7 +1455,7 @@ do { \ var gcv_object_t* next_list_ = &NEXT(argptr); \ var object next_list = *next_list_; \ - if (endp(next_list)) goto fertig; /* a list ended -> done */ \ + if (endp(next_list)) goto done; /* a list ended -> done */ \ pushSTACK(listaccess(next_list)); /* as argument on the stack */ \ *next_list_ = Cdr(next_list); /* shorten list */ \ } while (--count); \ @@ -1466,7 +1466,7 @@ if (nullp(STACK_1)) STACK_1 = STACK_0 = new_cons; /* init */ \ else { Cdr(STACK_0) = new_cons; STACK_0 = new_cons; } /* append */ \ }} \ - fertig: \ + done: \ VALUES1(*ret); /* result list-cons */ \ set_args_end_pointer(args_pointer); /* clean up STACK */ \ }} @@ -1488,13 +1488,13 @@ do { \ var gcv_object_t* next_list_ = &NEXT(argptr); \ var object next_list = *next_list_; \ - if (endp(next_list)) goto fertig; /* a list ended -> done */ \ + if (endp(next_list)) goto done; /* a list ended -> done */ \ pushSTACK(listaccess(next_list)); /* as argument on the stack */ \ *next_list_ = Cdr(next_list); /* shorten list */ \ } while (--count); \ funcall(fun,argcount); /* call function */ \ } \ - fertig: \ + done: \ VALUES1(*ergptr); /* first list as value */ \ set_args_end_pointer(args_pointer); /* clean up STACK */ \ }} @@ -1520,14 +1520,14 @@ do { \ var gcv_object_t* next_list_ = &NEXT(argptr); \ var object next_list = *next_list_; \ - if (endp(next_list)) goto fertig; /* a list ended -> done */ \ + if (endp(next_list)) goto done; /* a list ended -> done */ \ pushSTACK(listaccess(next_list)); /* as argument on the stack */ \ *next_list_ = Cdr(next_list); /* shorten list */ \ } while (--count); \ funcall(fun,argcount); /* call function */ \ append_function(value1); \ } \ - fertig: \ + done: \ VALUES1(*ret); /* result list */ \ set_args_end_pointer(args_pointer); /* clean up STACK */ \ }} @@ -2397,7 +2397,7 @@ var object arglistr = arglist; while (consp(arglistr)) { if (eq(Car(arglistr),S(Kallow_other_keys)) && !nullp(Car(Cdr(arglistr)))) - goto fertig; + goto done; arglistr = Cdr(Cdr(arglistr)); } } @@ -2408,7 +2408,7 @@ var object val = Car(arglistr); arglistr = Cdr(arglistr); if (eq(key,S(Kallow_other_keys))) { if (nullp(val)) break; /* need check */ - else goto fertig; /* no check */ + else goto done; /* no check */ } } for (arglistr = arglist; consp(arglistr); ) { @@ -2432,7 +2432,7 @@ } } } - fertig: + done: skipSTACK(2); VALUES1(NIL); } Index: lispbibl.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/lispbibl.d,v retrieving revision 1.747 retrieving revision 1.748 diff -u -d -r1.747 -r1.748 --- lispbibl.d 13 Dec 2007 22:27:46 -0000 1.747 +++ lispbibl.d 14 Dec 2007 15:41:57 -0000 1.748 @@ -11580,37 +11580,37 @@ # error_statement: if there's an error (too many values). #define NEXT_MV *mvp++ = Car(l); l = Cdr(l); count++ #if !defined(VALUE1_EXTRA) - #define list_to_mv(lst,error_statement) \ + #define list_to_mv(lst,error_statement) \ do { var object l = (lst); \ var uintC count = 0; \ if (atomp(l)) value1 = NIL; \ else { \ var object* mvp = &mv_space[0]; \ - NEXT_MV; if (atomp(l)) goto mv_fertig; \ - NEXT_MV; if (atomp(l)) goto mv_fertig; \ - NEXT_MV; if (atomp(l)) goto mv_fertig; \ - do { if (count==mv_limit-1) { error_statement; } NEXT_MV; \ + NEXT_MV; if (atomp(l)) goto mv_done; \ + NEXT_MV; if (atomp(l)) goto mv_done; \ + NEXT_MV; if (atomp(l)) goto mv_done; \ + do { if (count==mv_limit-1) { error_statement; } NEXT_MV; \ } while (consp(l)); \ } \ - mv_fertig: \ - if (!nullp(l)) error_proper_list_dotted(S(values_list),l); \ + mv_done: \ + if (!nullp(l)) error_proper_list_dotted(S(values_list),l); \ mv_count = count; \ } while(0) #else - #define list_to_mv(lst,error_statement) \ + #define list_to_mv(lst,error_statement) \ do { var object l = (lst); \ var uintC count = 0; \ if (atomp(l)) value1 = NIL; \ else { \ - value1 = Car(l); l = Cdr(l); count++; if (atomp(l)) goto mv_fertig; \ + value1 = Car(l); l = Cdr(l); count++; if (atomp(l)) goto mv_done; \ {var object* mvp = &mv_space[1]; \ - NEXT_MV; if (atomp(l)) goto mv_fertig; \ - NEXT_MV; if (atomp(l)) goto mv_fertig; \ - do { if (count==mv_limit-1) { error_statement; } NEXT_MV; \ + NEXT_MV; if (atomp(l)) goto mv_done; \ + NEXT_MV; if (atomp(l)) goto mv_done; \ + do { if (count==mv_limit-1) { error_statement; } NEXT_MV; \ } while (consp(l)); \ }} \ - mv_fertig: \ - if (!nullp(l)) error_proper_list_dotted(S(values_list),l); \ + mv_done: \ + if (!nullp(l)) error_proper_list_dotted(S(values_list),l); \ mv_count = count; \ } while(0) #endif ------------------------------ ------------------------------------------------------------------------- SF.Net email is sponsored by: Check out the new SourceForge.net Marketplace. It's the best place to buy or sell services for just about anything Open Source. http://ad.doubleclick.net/clk;164216239;13503038;w?http://sf.net/marketplace ------------------------------ _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest, Vol 20, Issue 30 ***************************************** |