Menu
▾
▴
[Maxima-commits] CVS: maxima/share/colnew/lisp approx.lisp, 1.3, 1.4 appsln.lisp, 1.3, 1.4 colnew.lisp, 1.3, 1.4 compat.lisp, 1.3, 1.4 consts.lisp, 1.3, 1.4 contrl.lisp, 1.3, 1.4 daxpy.lisp, 1.3, 1.4 ddot.lisp, 1.3, 1.4 dgefa.lisp, 1.3, 1.4 dgesl.lisp, 1.3, 1.4 dmzsol.lisp, 1.3, 1.4 dscal.lisp, 1.3, 1.4 errchk.lisp, 1.3, 1.4 factrb.lisp, 1.3, 1.4 fcblok.lisp, 1.3, 1.4 gblock.lisp, 1.3, 1.4 gderiv.lisp, 1.3, 1.4 horder.lisp, 1.3, 1.4 idamax.lisp, 1.3, 1.4 lsyslv.lisp, 1.3, 1.4 newmsh.lisp, 1.3, 1.4 rkbas.lisp, 1.3, 1.4 sbblok.lisp, 1.3, 1.4 shiftb.lisp, 1.3, 1.4 skale.lisp, 1.3, 1.4 subbak.lisp, 1.3, 1.4 subfor.lisp, 1.3, 1.4 vmonde.lisp, 1.3, 1.4 vwblok.lisp, 1.3, 1.4
Update of /cvsroot/maxima/maxima/share/colnew/lisp In directory sfp-cvsdas-4.v30.ch3.sourceforge.com:/tmp/cvs-serv2160/share/colnew/lisp Modified Files: approx.lisp appsln.lisp colnew.lisp compat.lisp consts.lisp contrl.lisp daxpy.lisp ddot.lisp dgefa.lisp dgesl.lisp dmzsol.lisp dscal.lisp errchk.lisp factrb.lisp fcblok.lisp gblock.lisp gderiv.lisp horder.lisp idamax.lisp lsyslv.lisp newmsh.lisp rkbas.lisp sbblok.lisp shiftb.lisp skale.lisp subbak.lisp subfor.lisp vmonde.lisp vwblok.lisp Log Message: Regenerated again with latest f2cl which now correctly pprints everything. (No change in functionality; just keeps lines (human-) readably shorter without unnecessary line breaks.) Index: approx.lisp =================================================================== RCS file: /cvsroot/maxima/maxima/share/colnew/lisp/approx.lisp,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- approx.lisp 26 May 2010 13:48:19 -0000 1.3 +++ approx.lisp 26 May 2010 19:49:47 -0000 1.4 @@ -1,5 +1,5 @@ ;;; Compiled by f2cl version: -;;; ("f2cl1.l,v 1.220 2010/05/26 03:22:59 rtoy Exp $" +;;; ("f2cl1.l,v 1.221 2010/05/26 19:25:52 rtoy Exp $" ;;; "f2cl2.l,v 1.37 2008/02/22 22:19:33 rtoy Exp $" ;;; "f2cl3.l,v 1.6 2008/02/22 22:19:33 rtoy Exp $" ;;; "f2cl4.l,v 1.7 2008/02/22 22:19:34 rtoy Exp $" @@ -28,266 +28,226 @@ (iout (aref (colout-part-1 *colout-common-block*) 0)) (iprint (aref (colout-part-1 *colout-common-block*) 1))) (f2cl-lib:with-multi-array-data - ((zval double-float zval-%data% zval-%offset%) - (coef double-float coef-%data% coef-%offset%) - (xi double-float xi-%data% xi-%offset%) - (z double-float z-%data% z-%offset%) - (dmz double-float dmz-%data% dmz-%offset%) - (dmval double-float dmval-%data% dmval-%offset%) - (a double-float a-%data% a-%offset%) - (m f2cl-lib:integer4 m-%data% m-%offset%)) - (prog ((fact 0.0) (lb 0) (ll 0) (zsum 0.0) (ind 0) (mj 0) (jcomp 0) - (idmz 0) (ir 0) (s 0.0) (iright 0) (l 0) (ileft 0) (j 0) (iz 0) - (dm (make-array 7 :element-type 'double-float)) - (bm (make-array 4 :element-type 'double-float))) - (declare (type (array double-float (4)) bm) - (type (array double-float (7)) dm) - (type (f2cl-lib:integer4) iz j ileft l iright ir idmz jcomp - mj ind ll lb) - (type double-float s zsum fact)) - (f2cl-lib:computed-goto (label10 label30 label80 label90) mode) - label10 - (setf x (f2cl-lib:fref xi-%data% (i) ((1 1)) xi-%offset%)) - (setf iz (f2cl-lib:int-mul (f2cl-lib:int-sub i 1) mstar)) - (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) - ((> j mstar) nil) - (tagbody - (setf iz (f2cl-lib:int-add iz 1)) - (setf (f2cl-lib:fref zval-%data% - (j) - ((1 1)) - zval-%offset%) - (f2cl-lib:fref z-%data% - (iz) - ((1 1)) - z-%offset%)) - label20)) - (go end_label) - label30 - (if - (and - (>= x (- (f2cl-lib:fref xi-%data% (1) ((1 1)) xi-%offset%) precis)) - (<= x - (+ - (f2cl-lib:fref xi-%data% - ((f2cl-lib:int-add n 1)) - ((1 1)) - xi-%offset%) - precis))) - (go label40)) - (if (< iprint 1) - (f2cl-lib:fformat iout - (" ****** DOMAIN ERROR IN APPROX ******" "~%" - " X =" 1 (("~20,10,2,0,'*,,'DE")) " ALEFT =" - 1 (("~20,10,2,0,'*,,'DE")) " ARIGHT =" 1 - (("~20,10,2,0,'*,,'DE")) "~%") - x - (f2cl-lib:fref xi-%data% - (1) - ((1 1)) - xi-%offset%) - (f2cl-lib:fref xi-%data% - ((f2cl-lib:int-add n 1)) - ((1 1)) - xi-%offset%))) - (if (< x (f2cl-lib:fref xi-%data% (1) ((1 1)) xi-%offset%)) - (setf x (f2cl-lib:fref xi-%data% (1) ((1 1)) xi-%offset%))) - (if - (> x - (f2cl-lib:fref xi-%data% - ((f2cl-lib:int-add n 1)) - ((1 1)) - xi-%offset%)) - (setf x + ((zval double-float zval-%data% zval-%offset%) + (coef double-float coef-%data% coef-%offset%) + (xi double-float xi-%data% xi-%offset%) + (z double-float z-%data% z-%offset%) + (dmz double-float dmz-%data% dmz-%offset%) + (dmval double-float dmval-%data% dmval-%offset%) + (a double-float a-%data% a-%offset%) + (m f2cl-lib:integer4 m-%data% m-%offset%)) + (prog ((fact 0.0) (lb 0) (ll 0) (zsum 0.0) (ind 0) (mj 0) (jcomp 0) + (idmz 0) (ir 0) (s 0.0) (iright 0) (l 0) (ileft 0) (j 0) (iz 0) + (dm (make-array 7 :element-type 'double-float)) + (bm (make-array 4 :element-type 'double-float))) + (declare (type (array double-float (4)) bm) + (type (array double-float (7)) dm) + (type (f2cl-lib:integer4) iz j ileft l iright ir idmz jcomp + mj ind ll lb) + (type double-float s zsum fact)) + (f2cl-lib:computed-goto (label10 label30 label80 label90) mode) + label10 + (setf x (f2cl-lib:fref xi-%data% (i) ((1 1)) xi-%offset%)) + (setf iz (f2cl-lib:int-mul (f2cl-lib:int-sub i 1) mstar)) + (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) + ((> j mstar) nil) + (tagbody + (setf iz (f2cl-lib:int-add iz 1)) + (setf (f2cl-lib:fref zval-%data% (j) ((1 1)) zval-%offset%) + (f2cl-lib:fref z-%data% (iz) ((1 1)) z-%offset%)) + label20)) + (go end_label) + label30 + (if + (and + (>= x (- (f2cl-lib:fref xi-%data% (1) ((1 1)) xi-%offset%) precis)) + (<= x + (+ + (f2cl-lib:fref xi-%data% + ((f2cl-lib:int-add n 1)) + ((1 1)) + xi-%offset%) + precis))) + (go label40)) + (if (< iprint 1) + (f2cl-lib:fformat iout + (" ****** DOMAIN ERROR IN APPROX ******" "~%" + " X =" 1 (("~20,10,2,0,'*,,'DE")) " ALEFT =" + 1 (("~20,10,2,0,'*,,'DE")) " ARIGHT =" 1 + (("~20,10,2,0,'*,,'DE")) "~%") + x + (f2cl-lib:fref xi-%data% + (1) + ((1 1)) + xi-%offset%) + (f2cl-lib:fref xi-%data% + ((f2cl-lib:int-add n 1)) + ((1 1)) + xi-%offset%))) + (if (< x (f2cl-lib:fref xi-%data% (1) ((1 1)) xi-%offset%)) + (setf x (f2cl-lib:fref xi-%data% (1) ((1 1)) xi-%offset%))) + (if + (> x + (f2cl-lib:fref xi-%data% + ((f2cl-lib:int-add n 1)) + ((1 1)) + xi-%offset%)) + (setf x + (f2cl-lib:fref xi-%data% + ((f2cl-lib:int-add n 1)) + ((1 1)) + xi-%offset%))) + label40 + (if (or (> i n) (< i 1)) + (setf i (the f2cl-lib:integer4 (truncate (+ n 1) 2)))) + (setf ileft i) + (if (< x (f2cl-lib:fref xi-%data% (ileft) ((1 1)) xi-%offset%)) + (go label60)) + (f2cl-lib:fdo (l ileft (f2cl-lib:int-add l 1)) + ((> l n) nil) + (tagbody + (setf i l) + (if + (< x (f2cl-lib:fref xi-%data% - ((f2cl-lib:int-add n 1)) + ((f2cl-lib:int-add l 1)) ((1 1)) - xi-%offset%))) - label40 - (if (or (> i n) (< i 1)) - (setf i (the f2cl-lib:integer4 (truncate (+ n 1) 2)))) - (setf ileft i) - (if (< x (f2cl-lib:fref xi-%data% (ileft) ((1 1)) xi-%offset%)) - (go label60)) - (f2cl-lib:fdo (l ileft (f2cl-lib:int-add l 1)) - ((> l n) nil) - (tagbody - (setf i l) - (if - (< x - (f2cl-lib:fref xi-%data% - ((f2cl-lib:int-add l 1)) - ((1 1)) - xi-%offset%)) - (go label80)) - label50)) - (go label80) - label60 - (setf iright (f2cl-lib:int-sub ileft 1)) - (f2cl-lib:fdo (l 1 (f2cl-lib:int-add l 1)) - ((> l iright) nil) - (tagbody - (setf i - (f2cl-lib:int-sub (f2cl-lib:int-add iright 1) - l)) - (if - (>= x - (f2cl-lib:fref xi-%data% - (i) - ((1 1)) - xi-%offset%)) - (go label80)) - label70)) - label80 - (setf s - (/ (- x (f2cl-lib:fref xi-%data% (i) ((1 1)) xi-%offset%)) - (- - (f2cl-lib:fref xi-%data% - ((f2cl-lib:int-add i 1)) - ((1 1)) - xi-%offset%) - (f2cl-lib:fref xi-%data% (i) ((1 1)) xi-%offset%)))) - (rkbas s coef k mmax a dm modm) - label90 - (setf (f2cl-lib:fref bm (1) ((1 4))) - (- x (f2cl-lib:fref xi-%data% (i) ((1 1)) xi-%offset%))) - (f2cl-lib:fdo (l 2 (f2cl-lib:int-add l 1)) - ((> l mmax) nil) - (tagbody - (setf (f2cl-lib:fref bm (l) ((1 4))) - (/ (f2cl-lib:fref bm (1) ((1 4))) - (f2cl-lib:dfloat l))) - label95)) - label100 - (setf ir 1) - (setf iz - (f2cl-lib:int-add - (f2cl-lib:int-mul (f2cl-lib:int-sub i 1) mstar) - 1)) - (setf idmz (f2cl-lib:int-mul (f2cl-lib:int-sub i 1) k ncomp)) - (f2cl-lib:fdo (jcomp 1 (f2cl-lib:int-add jcomp 1)) - ((> jcomp ncomp) nil) - (tagbody - (setf mj - (f2cl-lib:fref m-%data% - (jcomp) + xi-%offset%)) + (go label80)) + label50)) + (go label80) + label60 + (setf iright (f2cl-lib:int-sub ileft 1)) + (f2cl-lib:fdo (l 1 (f2cl-lib:int-add l 1)) + ((> l iright) nil) + (tagbody + (setf i (f2cl-lib:int-sub (f2cl-lib:int-add iright 1) l)) + (if (>= x (f2cl-lib:fref xi-%data% (i) ((1 1)) xi-%offset%)) + (go label80)) + label70)) + label80 + (setf s + (/ (- x (f2cl-lib:fref xi-%data% (i) ((1 1)) xi-%offset%)) + (- + (f2cl-lib:fref xi-%data% + ((f2cl-lib:int-add i 1)) + ((1 1)) + xi-%offset%) + (f2cl-lib:fref xi-%data% (i) ((1 1)) xi-%offset%)))) + (rkbas s coef k mmax a dm modm) + label90 + (setf (f2cl-lib:fref bm (1) ((1 4))) + (- x (f2cl-lib:fref xi-%data% (i) ((1 1)) xi-%offset%))) + (f2cl-lib:fdo (l 2 (f2cl-lib:int-add l 1)) + ((> l mmax) nil) + (tagbody + (setf (f2cl-lib:fref bm (l) ((1 4))) + (/ (f2cl-lib:fref bm (1) ((1 4))) (f2cl-lib:dfloat l))) + label95)) + label100 + (setf ir 1) + (setf iz + (f2cl-lib:int-add + (f2cl-lib:int-mul (f2cl-lib:int-sub i 1) mstar) + 1)) + (setf idmz (f2cl-lib:int-mul (f2cl-lib:int-sub i 1) k ncomp)) + (f2cl-lib:fdo (jcomp 1 (f2cl-lib:int-add jcomp 1)) + ((> jcomp ncomp) nil) + (tagbody + (setf mj (f2cl-lib:fref m-%data% (jcomp) ((1 1)) m-%offset%)) + (setf ir (f2cl-lib:int-add ir mj)) + (setf iz (f2cl-lib:int-add iz mj)) + (f2cl-lib:fdo (l 1 (f2cl-lib:int-add l 1)) + ((> l mj) nil) + (tagbody + (setf ind (f2cl-lib:int-add idmz jcomp)) + (setf zsum 0.0) + (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) + ((> j k) nil) + (tagbody + (setf zsum + (+ zsum + (* + (f2cl-lib:fref a-%data% + (j l) + ((1 7) (1 1)) + a-%offset%) + (f2cl-lib:fref dmz-%data% + (ind) + ((1 1)) + dmz-%offset%)))) + label110 + (setf ind (f2cl-lib:int-add ind ncomp)))) + (f2cl-lib:fdo (ll 1 (f2cl-lib:int-add ll 1)) + ((> ll l) nil) + (tagbody + (setf lb (f2cl-lib:int-sub (f2cl-lib:int-add l 1) ll)) + label120 + (setf zsum + (+ (* zsum (f2cl-lib:fref bm (lb) ((1 4)))) + (f2cl-lib:fref z-%data% + ((f2cl-lib:int-sub iz ll)) ((1 1)) - m-%offset%)) - (setf ir (f2cl-lib:int-add ir mj)) - (setf iz (f2cl-lib:int-add iz mj)) - (f2cl-lib:fdo (l 1 (f2cl-lib:int-add l 1)) - ((> l mj) nil) - (tagbody - (setf ind - (f2cl-lib:int-add idmz jcomp)) - (setf zsum 0.0) - (f2cl-lib:fdo - (j 1 (f2cl-lib:int-add j 1)) - ((> j k) nil) - (tagbody - (setf zsum - (+ zsum - (* - (f2cl-lib:fref a-%data% - (j l) - ((1 7) - (1 1)) - a-%offset%) - (f2cl-lib:fref - dmz-%data% - (ind) - ((1 1)) - dmz-%offset%)))) - label110 - (setf ind - (f2cl-lib:int-add ind - ncomp)))) - (f2cl-lib:fdo - (ll 1 (f2cl-lib:int-add ll 1)) - ((> ll l) nil) - (tagbody - (setf lb - (f2cl-lib:int-sub - (f2cl-lib:int-add l 1) - ll)) - label120 - (setf zsum - (+ - (* zsum - (f2cl-lib:fref bm - (lb) - ((1 - 4)))) - (f2cl-lib:fref z-%data% - ((f2cl-lib:int-sub - iz - ll)) - ((1 1)) - z-%offset%))))) - label130 - (setf (f2cl-lib:fref zval-%data% - ((f2cl-lib:int-sub - ir - l)) - ((1 1)) - zval-%offset%) - zsum))) - label140)) - (if (= modm 0) (go end_label)) - (f2cl-lib:fdo (jcomp 1 (f2cl-lib:int-add jcomp 1)) - ((> jcomp ncomp) nil) - (tagbody - label150 - (setf (f2cl-lib:fref dmval-%data% - (jcomp) - ((1 1)) - dmval-%offset%) - 0.0))) - (setf idmz (f2cl-lib:int-add idmz 1)) - (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) - ((> j k) nil) - (tagbody - (setf fact (f2cl-lib:fref dm (j) ((1 7)))) - (f2cl-lib:fdo (jcomp 1 (f2cl-lib:int-add jcomp 1)) - ((> jcomp ncomp) nil) - (tagbody - (setf (f2cl-lib:fref dmval-%data% - (jcomp) - ((1 1)) - dmval-%offset%) - (+ - (f2cl-lib:fref dmval-%data% - (jcomp) - ((1 1)) - dmval-%offset%) - (* fact - (f2cl-lib:fref dmz-%data% - (idmz) - ((1 1)) - dmz-%offset%)))) - (setf idmz (f2cl-lib:int-add idmz 1)) - label160)) - label170)) - (go end_label) - end_label - (return - (values i - x - nil - nil - nil - nil - nil - nil - nil - nil - nil - nil - nil - nil - nil - nil - nil))))))) + z-%offset%))))) + label130 + (setf (f2cl-lib:fref zval-%data% + ((f2cl-lib:int-sub ir l)) + ((1 1)) + zval-%offset%) + zsum))) + label140)) + (if (= modm 0) (go end_label)) + (f2cl-lib:fdo (jcomp 1 (f2cl-lib:int-add jcomp 1)) + ((> jcomp ncomp) nil) + (tagbody + label150 + (setf (f2cl-lib:fref dmval-%data% (jcomp) ((1 1)) dmval-%offset%) + 0.0))) + (setf idmz (f2cl-lib:int-add idmz 1)) + (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) + ((> j k) nil) + (tagbody + (setf fact (f2cl-lib:fref dm (j) ((1 7)))) + (f2cl-lib:fdo (jcomp 1 (f2cl-lib:int-add jcomp 1)) + ((> jcomp ncomp) nil) + (tagbody + (setf (f2cl-lib:fref dmval-%data% + (jcomp) + ((1 1)) + dmval-%offset%) + (+ + (f2cl-lib:fref dmval-%data% + (jcomp) + ((1 1)) + dmval-%offset%) + (* fact + (f2cl-lib:fref dmz-%data% + (idmz) + ((1 1)) + dmz-%offset%)))) + (setf idmz (f2cl-lib:int-add idmz 1)) + label160)) + label170)) + (go end_label) + end_label + (return + (values i + x + nil + nil + nil + nil + nil + nil + nil + nil + nil + nil + nil + nil + nil + nil + nil))))))) (in-package #-gcl #:cl-user #+gcl "CL-USER") #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or)) Index: appsln.lisp =================================================================== RCS file: /cvsroot/maxima/maxima/share/colnew/lisp/appsln.lisp,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- appsln.lisp 26 May 2010 13:48:19 -0000 1.3 +++ appsln.lisp 26 May 2010 19:49:47 -0000 1.4 @@ -1,5 +1,5 @@ ;;; Compiled by f2cl version: -;;; ("f2cl1.l,v 1.220 2010/05/26 03:22:59 rtoy Exp $" +;;; ("f2cl1.l,v 1.221 2010/05/26 19:25:52 rtoy Exp $" ;;; "f2cl2.l,v 1.37 2008/02/22 22:19:33 rtoy Exp $" ;;; "f2cl3.l,v 1.6 2008/02/22 22:19:33 rtoy Exp $" ;;; "f2cl4.l,v 1.7 2008/02/22 22:19:34 rtoy Exp $" @@ -22,55 +22,55 @@ (type (array double-float (*)) fspace z) (type double-float x)) (f2cl-lib:with-multi-array-data - ((z double-float z-%data% z-%offset%) - (fspace double-float fspace-%data% fspace-%offset%) - (ispace f2cl-lib:integer4 ispace-%data% ispace-%offset%)) - (prog ((a (make-array 28 :element-type 'double-float)) - (dummy (make-array 1 :element-type 'double-float)) (i 0) (is4 0) - (is5 0) (is6 0)) - (declare (type (f2cl-lib:integer4) is6 is5 is4 i) - (type (array double-float (1)) dummy) - (type (array double-float (28)) a)) - (setf is6 (f2cl-lib:fref ispace-%data% (6) ((1 1)) ispace-%offset%)) - (setf is5 - (f2cl-lib:int-add - (f2cl-lib:fref ispace-%data% (1) ((1 1)) ispace-%offset%) - 2)) - (setf is4 - (f2cl-lib:int-add is5 - (f2cl-lib:int-mul - (f2cl-lib:fref ispace-%data% - (4) - ((1 1)) - ispace-%offset%) - (f2cl-lib:int-add + ((z double-float z-%data% z-%offset%) + (fspace double-float fspace-%data% fspace-%offset%) + (ispace f2cl-lib:integer4 ispace-%data% ispace-%offset%)) + (prog ((a (make-array 28 :element-type 'double-float)) + (dummy (make-array 1 :element-type 'double-float)) (i 0) (is4 0) + (is5 0) (is6 0)) + (declare (type (f2cl-lib:integer4) is6 is5 is4 i) + (type (array double-float (1)) dummy) + (type (array double-float (28)) a)) + (setf is6 (f2cl-lib:fref ispace-%data% (6) ((1 1)) ispace-%offset%)) + (setf is5 + (f2cl-lib:int-add + (f2cl-lib:fref ispace-%data% (1) ((1 1)) ispace-%offset%) + 2)) + (setf is4 + (f2cl-lib:int-add is5 + (f2cl-lib:int-mul (f2cl-lib:fref ispace-%data% - (1) + (4) ((1 1)) ispace-%offset%) - 1)))) - (setf i 1) - (multiple-value-bind - (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9 var-10 - var-11 var-12 var-13 var-14 var-15 var-16) - (approx i x z a - (f2cl-lib:array-slice fspace double-float (is6) ((1 1))) - (f2cl-lib:array-slice fspace double-float (1) ((1 1))) - (f2cl-lib:fref ispace-%data% (1) ((1 1)) ispace-%offset%) - (f2cl-lib:array-slice fspace double-float (is5) ((1 1))) - (f2cl-lib:array-slice fspace double-float (is4) ((1 1))) - (f2cl-lib:fref ispace-%data% (2) ((1 1)) ispace-%offset%) - (f2cl-lib:fref ispace-%data% (3) ((1 1)) ispace-%offset%) - (f2cl-lib:fref ispace-%data% (5) ((1 1)) ispace-%offset%) - (f2cl-lib:array-slice ispace f2cl-lib:integer4 (8) ((1 1))) - (f2cl-lib:fref ispace-%data% (4) ((1 1)) ispace-%offset%) 2 dummy 0) - (declare (ignore var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9 var-10 - var-11 var-12 var-13 var-14 var-15 var-16)) - (setf i var-0) - (setf x var-1)) - (go end_label) - end_label - (return (values x nil nil nil))))) + (f2cl-lib:int-add + (f2cl-lib:fref ispace-%data% + (1) + ((1 1)) + ispace-%offset%) + 1)))) + (setf i 1) + (multiple-value-bind + (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9 var-10 + var-11 var-12 var-13 var-14 var-15 var-16) + (approx i x z a + (f2cl-lib:array-slice fspace double-float (is6) ((1 1))) + (f2cl-lib:array-slice fspace double-float (1) ((1 1))) + (f2cl-lib:fref ispace-%data% (1) ((1 1)) ispace-%offset%) + (f2cl-lib:array-slice fspace double-float (is5) ((1 1))) + (f2cl-lib:array-slice fspace double-float (is4) ((1 1))) + (f2cl-lib:fref ispace-%data% (2) ((1 1)) ispace-%offset%) + (f2cl-lib:fref ispace-%data% (3) ((1 1)) ispace-%offset%) + (f2cl-lib:fref ispace-%data% (5) ((1 1)) ispace-%offset%) + (f2cl-lib:array-slice ispace f2cl-lib:integer4 (8) ((1 1))) + (f2cl-lib:fref ispace-%data% (4) ((1 1)) ispace-%offset%) 2 dummy 0) + (declare (ignore var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9 var-10 + var-11 var-12 var-13 var-14 var-15 var-16)) + (setf i var-0) + (setf x var-1)) + (go end_label) + end_label + (return (values x nil nil nil))))) (in-package #-gcl #:cl-user #+gcl "CL-USER") #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or)) Index: colnew.lisp =================================================================== RCS file: /cvsroot/maxima/maxima/share/colnew/lisp/colnew.lisp,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- colnew.lisp 26 May 2010 13:48:19 -0000 1.3 +++ colnew.lisp 26 May 2010 19:49:47 -0000 1.4 @@ -1,5 +1,5 @@ ;;; Compiled by f2cl version: -;;; ("f2cl1.l,v 1.220 2010/05/26 03:22:59 rtoy Exp $" +;;; ("f2cl1.l,v 1.221 2010/05/26 19:25:52 rtoy Exp $" ;;; "f2cl2.l,v 1.37 2008/02/22 22:19:33 rtoy Exp $" ;;; "f2cl3.l,v 1.6 2008/02/22 22:19:33 rtoy Exp $" ;;; "f2cl4.l,v 1.7 2008/02/22 22:19:34 rtoy Exp $" @@ -118,835 +118,791 @@ (aref (colest-part-1 *colest-common-block*) 80))) (f2cl-lib:with-multi-array-data - ((m f2cl-lib:integer4 m-%data% m-%offset%) [...1586 lines suppressed...] + (values nil + nil + nil + nil + nil + nil + nil + nil + nil + nil + nil + iflag + nil + nil + nil + nil + nil)))))))) (defun colnew (ncomp m aleft aright zeta ipar ltol tol fixpnt ispace fspace iflag fsub dfsub gsub dgsub guess) Index: compat.lisp =================================================================== RCS file: /cvsroot/maxima/maxima/share/colnew/lisp/compat.lisp,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- compat.lisp 26 May 2010 13:48:19 -0000 1.3 +++ compat.lisp 26 May 2010 19:49:47 -0000 1.4 @@ -1,5 +1,5 @@ ;;; Compiled by f2cl version: -;;; ("f2cl1.l,v 1.220 2010/05/26 03:22:59 rtoy Exp $" +;;; ("f2cl1.l,v 1.221 2010/05/26 19:25:52 rtoy Exp $" ;;; "f2cl2.l,v 1.37 2008/02/22 22:19:33 rtoy Exp $" ;;; "f2cl3.l,v 1.6 2008/02/22 22:19:33 rtoy Exp $" ;;; "f2cl4.l,v 1.7 2008/02/22 22:19:34 rtoy Exp $" Index: consts.lisp =================================================================== RCS file: /cvsroot/maxima/maxima/share/colnew/lisp/consts.lisp,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- consts.lisp 26 May 2010 13:48:19 -0000 1.3 +++ consts.lisp 26 May 2010 19:49:47 -0000 1.4 @@ -1,5 +1,5 @@ ;;; Compiled by f2cl version: -;;; ("f2cl1.l,v 1.220 2010/05/26 03:22:59 rtoy Exp $" +;;; ("f2cl1.l,v 1.221 2010/05/26 19:25:52 rtoy Exp $" ;;; "f2cl2.l,v 1.37 2008/02/22 22:19:33 rtoy Exp $" ;;; "f2cl3.l,v 1.6 2008/02/22 22:19:33 rtoy Exp $" ;;; "f2cl4.l,v 1.7 2008/02/22 22:19:34 rtoy Exp $" @@ -106,206 +106,187 @@ (ltol colest-ltol) (ntol (aref (colest-part-1 *colest-common-block*) 80))) (f2cl-lib:with-multi-array-data - ((rho double-float rho-%data% rho-%offset%) - (coef double-float coef-%data% coef-%offset%)) - (prog ((ltoli 0) (i 0) (mtot 0) (jcomp 0) (l 0) (mj 0) (j 0) (iz 0) - (koff 0) (dummy (make-array 1 :element-type 'double-float))) - (declare (type (array double-float (1)) dummy) - (type (f2cl-lib:integer4) koff iz j mj l jcomp mtot i - ltoli)) - (setf koff (the f2cl-lib:integer4 (truncate (* k (+ k 1)) 2))) - (setf iz 1) - (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) - ((> j ncomp) nil) - (tagbody - (setf mj (f2cl-lib:fref m (j) ((1 20)))) - (f2cl-lib:fdo (l 1 (f2cl-lib:int-add l 1)) - ((> l mj) nil) - (tagbody - (setf (f2cl-lib:fref wgterr - (iz) - ((1 40))) - (f2cl-lib:fref cnsts1 - ((f2cl-lib:int-add - (f2cl-lib:int-sub - koff - mj) - l)) - ((1 28)))) - (setf iz (f2cl-lib:int-add iz 1)) - label10)))) - label10 - (setf jcomp 1) - (setf mtot (f2cl-lib:fref m (1) ((1 20)))) - (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) - ((> i ntol) nil) - (tagbody - (setf ltoli (f2cl-lib:fref ltol (i) ((1 40)))) - label20 - (if (<= ltoli mtot) (go label30)) - (setf jcomp (f2cl-lib:int-add jcomp 1)) - (setf mtot - (f2cl-lib:int-add mtot - (f2cl-lib:fref m - (jcomp) - ((1 20))))) - (go label20) - label30 - (setf (f2cl-lib:fref jtol (i) ((1 40))) jcomp) - (setf (f2cl-lib:fref wgtmsh (i) ((1 40))) - (/ - (* 10.0 - (f2cl-lib:fref cnsts2 - ((f2cl-lib:int-sub - (f2cl-lib:int-add koff - ltoli) - mtot)) - ((1 28)))) - (f2cl-lib:fref tolin (i) ((1 40))))) - (setf (f2cl-lib:fref root (i) ((1 40))) - (/ 1.0 - (f2cl-lib:dfloat - (f2cl-lib:int-add - (f2cl-lib:int-sub - (f2cl-lib:int-add k mtot) - ltoli) - 1)))) - label40)) - (f2cl-lib:computed-goto - (label50 label60 label70 label80 label90 label100 label110) - k) - label50 - (setf (f2cl-lib:fref rho-%data% (1) ((1 7)) rho-%offset%) 0.0) - (go label120) - label60 - (setf (f2cl-lib:fref rho-%data% (2) ((1 7)) rho-%offset%) - 0.5773502691896257) - (setf (f2cl-lib:fref rho-%data% (1) ((1 7)) rho-%offset%) - (- (f2cl-lib:fref rho-%data% (2) ((1 7)) rho-%offset%))) - (go label120) - label70 - (setf (f2cl-lib:fref rho-%data% (3) ((1 7)) rho-%offset%) - 0.7745966692414834) - (setf (f2cl-lib:fref rho-%data% (2) ((1 7)) rho-%offset%) 0.0) - (setf (f2cl-lib:fref rho-%data% (1) ((1 7)) rho-%offset%) - (- (f2cl-lib:fref rho-%data% (3) ((1 7)) rho-%offset%))) - (go label120) - label80 - (setf (f2cl-lib:fref rho-%data% (4) ((1 7)) rho-%offset%) - 0.8611363115940526) - (setf (f2cl-lib:fref rho-%data% (3) ((1 7)) rho-%offset%) - 0.33998104358485626) - (setf (f2cl-lib:fref rho-%data% (2) ((1 7)) rho-%offset%) - (- (f2cl-lib:fref rho-%data% (3) ((1 7)) rho-%offset%))) - (setf (f2cl-lib:fref rho-%data% (1) ((1 7)) rho-%offset%) - (- (f2cl-lib:fref rho-%data% (4) ((1 7)) rho-%offset%))) - (go label120) - label90 - (setf (f2cl-lib:fref rho-%data% (5) ((1 7)) rho-%offset%) - 0.906179845938664) - (setf (f2cl-lib:fref rho-%data% (4) ((1 7)) rho-%offset%) - 0.5384693101056831) - (setf (f2cl-lib:fref rho-%data% (3) ((1 7)) rho-%offset%) 0.0) - (setf (f2cl-lib:fref rho-%data% (2) ((1 7)) rho-%offset%) - (- (f2cl-lib:fref rho-%data% (4) ((1 7)) rho-%offset%))) - (setf (f2cl-lib:fref rho-%data% (1) ((1 7)) rho-%offset%) - (- (f2cl-lib:fref rho-%data% (5) ((1 7)) rho-%offset%))) - (go label120) - label100 - (setf (f2cl-lib:fref rho-%data% (6) ((1 7)) rho-%offset%) - 0.932469514203152) - (setf (f2cl-lib:fref rho-%data% (5) ((1 7)) rho-%offset%) - 0.6612093864662645) - (setf (f2cl-lib:fref rho-%data% (4) ((1 7)) rho-%offset%) - 0.2386191860831969) - (setf (f2cl-lib:fref rho-%data% (3) ((1 7)) rho-%offset%) - (- (f2cl-lib:fref rho-%data% (4) ((1 7)) rho-%offset%))) - (setf (f2cl-lib:fref rho-%data% (2) ((1 7)) rho-%offset%) - (- (f2cl-lib:fref rho-%data% (5) ((1 7)) rho-%offset%))) - (setf (f2cl-lib:fref rho-%data% (1) ((1 7)) rho-%offset%) - (- (f2cl-lib:fref rho-%data% (6) ((1 7)) rho-%offset%))) - (go label120) - label110 - (setf (f2cl-lib:fref rho-%data% (7) ((1 7)) rho-%offset%) - 0.9491079912342758) - (setf (f2cl-lib:fref rho-%data% (6) ((1 7)) rho-%offset%) - 0.7415311855993945) - (setf (f2cl-lib:fref rho-%data% (5) ((1 7)) rho-%offset%) - 0.4058451513773972) - (setf (f2cl-lib:fref rho-%data% (4) ((1 7)) rho-%offset%) 0.0) - (setf (f2cl-lib:fref rho-%data% (3) ((1 7)) rho-%offset%) - (- (f2cl-lib:fref rho-%data% (5) ((1 7)) rho-%offset%))) - (setf (f2cl-lib:fref rho-%data% (2) ((1 7)) rho-%offset%) - (- (f2cl-lib:fref rho-%data% (6) ((1 7)) rho-%offset%))) - (setf (f2cl-lib:fref rho-%data% (1) ((1 7)) rho-%offset%) - (- (f2cl-lib:fref rho-%data% (7) ((1 7)) rho-%offset%))) - label120 - (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) - ((> j k) nil) - (tagbody - (setf (f2cl-lib:fref rho-%data% - (j) - ((1 7)) - rho-%offset%) - (* 0.5 - (+ 1.0 - (f2cl-lib:fref rho-%data% - (j) - ((1 7)) - rho-%offset%)))) - label130)) - (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) - ((> j k) nil) - (tagbody - (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) - ((> i k) nil) - (tagbody - label135 - (setf (f2cl-lib:fref coef-%data% - (i j) - ((1 k) (1 1)) - coef-%offset%) - 0.0))) - (setf (f2cl-lib:fref coef-%data% - (j j) - ((1 k) (1 1)) - coef-%offset%) - 1.0) - (vmonde rho - (f2cl-lib:array-slice coef - double-float - (1 j) - ((1 k) (1 1))) - k) - label140)) - (rkbas 1.0 coef k mmax b dummy 0) - (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) - ((> i k) nil) - (tagbody - (rkbas - (f2cl-lib:fref rho-%data% (i) ((1 7)) rho-%offset%) - coef k mmax - (f2cl-lib:array-slice acol - double-float - (1 i) - ((1 28) (1 7))) - dummy 0) - label150)) - (rkbas (/ 1.0 6.0) coef k mmax - (f2cl-lib:array-slice asave double-float (1 1) ((1 28) (1 4))) - dummy 0) - (rkbas (/ 1.0 3.0) coef k mmax - (f2cl-lib:array-slice asave double-float (1 2) ((1 28) (1 4))) - dummy 0) - (rkbas (/ 2.0 3.0) coef k mmax - (f2cl-lib:array-slice asave double-float (1 3) ((1 28) (1 4))) - dummy 0) - (rkbas (/ 5.0 6.0) coef k mmax - (f2cl-lib:array-slice asave double-float (1 4) ((1 28) (1 4))) - dummy 0) - (go end_label) - end_label - (return (values nil nil nil)))))))) + ((rho double-float rho-%data% rho-%offset%) + (coef double-float coef-%data% coef-%offset%)) + (prog ((ltoli 0) (i 0) (mtot 0) (jcomp 0) (l 0) (mj 0) (j 0) (iz 0) + (koff 0) (dummy (make-array 1 :element-type 'double-float))) + (declare (type (array double-float (1)) dummy) + (type (f2cl-lib:integer4) koff iz j mj l jcomp mtot i + ltoli)) + (setf koff (the f2cl-lib:integer4 (truncate (* k (+ k 1)) 2))) + (setf iz 1) + (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) + ((> j ncomp) nil) + (tagbody + (setf mj (f2cl-lib:fref m (j) ((1 20)))) + (f2cl-lib:fdo (l 1 (f2cl-lib:int-add l 1)) + ((> l mj) nil) + (tagbody + (setf (f2cl-lib:fref wgterr (iz) ((1 40))) + (f2cl-lib:fref cnsts1 + ((f2cl-lib:int-add + (f2cl-lib:int-sub koff mj) + l)) + ((1 28)))) + (setf iz (f2cl-lib:int-add iz 1)) + label10)))) + label10 + (setf jcomp 1) + (setf mtot (f2cl-lib:fref m (1) ((1 20)))) + (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) + ((> i ntol) nil) + (tagbody + (setf ltoli (f2cl-lib:fref ltol (i) ((1 40)))) + label20 + (if (<= ltoli mtot) (go label30)) + (setf jcomp (f2cl-lib:int-add jcomp 1)) + (setf mtot + (f2cl-lib:int-add mtot + (f2cl-lib:fref m (jcomp) ((1 20))))) + (go label20) + label30 + (setf (f2cl-lib:fref jtol (i) ((1 40))) jcomp) + (setf (f2cl-lib:fref wgtmsh (i) ((1 40))) + (/ + (* 10.0 + (f2cl-lib:fref cnsts2 + ((f2cl-lib:int-sub + (f2cl-lib:int-add koff ltoli) + mtot)) + ((1 28)))) + (f2cl-lib:fref tolin (i) ((1 40))))) + (setf (f2cl-lib:fref root (i) ((1 40))) + (/ 1.0 + (f2cl-lib:dfloat + (f2cl-lib:int-add + (f2cl-lib:int-sub (f2cl-lib:int-add k mtot) ltoli) + 1)))) + label40)) + (f2cl-lib:computed-goto + (label50 label60 label70 label80 label90 label100 label110) + k) + label50 + (setf (f2cl-lib:fref rho-%data% (1) ((1 7)) rho-%offset%) 0.0) + (go label120) + label60 + (setf (f2cl-lib:fref rho-%data% (2) ((1 7)) rho-%offset%) + 0.5773502691896257) + (setf (f2cl-lib:fref rho-%data% (1) ((1 7)) rho-%offset%) + (- (f2cl-lib:fref rho-%data% (2) ((1 7)) rho-%offset%))) + (go label120) + label70 + (setf (f2cl-lib:fref rho-%data% (3) ((1 7)) rho-%offset%) + 0.7745966692414834) + (setf (f2cl-lib:fref rho-%data% (2) ((1 7)) rho-%offset%) 0.0) + (setf (f2cl-lib:fref rho-%data% (1) ((1 7)) rho-%offset%) + (- (f2cl-lib:fref rho-%data% (3) ((1 7)) rho-%offset%))) + (go label120) + label80 + (setf (f2cl-lib:fref rho-%data% (4) ((1 7)) rho-%offset%) + 0.8611363115940526) + (setf (f2cl-lib:fref rho-%data% (3) ((1 7)) rho-%offset%) + 0.33998104358485626) + (setf (f2cl-lib:fref rho-%data% (2) ((1 7)) rho-%offset%) + (- (f2cl-lib:fref rho-%data% (3) ((1 7)) rho-%offset%))) + (setf (f2cl-lib:fref rho-%data% (1) ((1 7)) rho-%offset%) + (- (f2cl-lib:fref rho-%data% (4) ((1 7)) rho-%offset%))) + (go label120) + label90 + (setf (f2cl-lib:fref rho-%data% (5) ((1 7)) rho-%offset%) + 0.906179845938664) + (setf (f2cl-lib:fref rho-%data% (4) ((1 7)) rho-%offset%) + 0.5384693101056831) + (setf (f2cl-lib:fref rho-%data% (3) ((1 7)) rho-%offset%) 0.0) + (setf (f2cl-lib:fref rho-%data% (2) ((1 7)) rho-%offset%) + (- (f2cl-lib:fref rho-%data% (4) ((1 7)) rho-%offset%))) + (setf (f2cl-lib:fref rho-%data% (1) ((1 7)) rho-%offset%) + (- (f2cl-lib:fref rho-%data% (5) ((1 7)) rho-%offset%))) + (go label120) + label100 + (setf (f2cl-lib:fref rho-%data% (6) ((1 7)) rho-%offset%) + 0.932469514203152) + (setf (f2cl-lib:fref rho-%data% (5) ((1 7)) rho-%offset%) + 0.6612093864662645) + (setf (f2cl-lib:fref rho-%data% (4) ((1 7)) rho-%offset%) + 0.2386191860831969) + (setf (f2cl-lib:fref rho-%data% (3) ((1 7)) rho-%offset%) + (- (f2cl-lib:fref rho-%data% (4) ((1 7)) rho-%offset%))) + (setf (f2cl-lib:fref rho-%data% (2) ((1 7)) rho-%offset%) + (- (f2cl-lib:fref rho-%data% (5) ((1 7)) rho-%offset%))) + (setf (f2cl-lib:fref rho-%data% (1) ((1 7)) rho-%offset%) + (- (f2cl-lib:fref rho-%data% (6) ((1 7)) rho-%offset%))) + (go label120) + label110 + (setf (f2cl-lib:fref rho-%data% (7) ((1 7)) rho-%offset%) + 0.9491079912342758) + (setf (f2cl-lib:fref rho-%data% (6) ((1 7)) rho-%offset%) + 0.7415311855993945) + (setf (f2cl-lib:fref rho-%data% (5) ((1 7)) rho-%offset%) + 0.4058451513773972) + (setf (f2cl-lib:fref rho-%data% (4) ((1 7)) rho-%offset%) 0.0) + (setf (f2cl-lib:fref rho-%data% (3) ((1 7)) rho-%offset%) + (- (f2cl-lib:fref rho-%data% (5) ((1 7)) rho-%offset%))) + (setf (f2cl-lib:fref rho-%data% (2) ((1 7)) rho-%offset%) + (- (f2cl-lib:fref rho-%data% (6) ((1 7)) rho-%offset%))) + (setf (f2cl-lib:fref rho-%data% (1) ((1 7)) rho-%offset%) + (- (f2cl-lib:fref rho-%data% (7) ((1 7)) rho-%offset%))) + label120 + (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) + ((> j k) nil) + (tagbody + (setf (f2cl-lib:fref rho-%data% (j) ((1 7)) rho-%offset%) + (* 0.5 + (+ 1.0 + (f2cl-lib:fref rho-%data% + (j) + ((1 7)) + rho-%offset%)))) + label130)) + (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) + ((> j k) nil) + (tagbody + (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) + ((> i k) nil) + (tagbody + label135 + (setf (f2cl-lib:fref coef-%data% + (i j) + ((1 k) (1 1)) + coef-%offset%) + 0.0))) + (setf (f2cl-lib:fref coef-%data% + (j j) + ((1 k) (1 1)) + coef-%offset%) + 1.0) + (vmonde rho + (f2cl-lib:array-slice coef double-float (1 j) ((1 k) (1 1))) + k) + label140)) + (rkbas 1.0 coef k mmax b dummy 0) + (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) + ((> i k) nil) + (tagbody + (rkbas (f2cl-lib:fref rho-%data% (i) ((1 7)) rho-%offset%) coef + k mmax + (f2cl-lib:array-slice acol double-float (1 i) ((1 28) (1 7))) + dummy 0) + label150)) + (rkbas (/ 1.0 6.0) coef k mmax + (f2cl-lib:array-slice asave double-float (1 1) ((1 28) (1 4))) + dummy 0) + (rkbas (/ 1.0 3.0) coef k mmax + (f2cl-lib:array-slice asave double-float (1 2) ((1 28) (1 4))) + dummy 0) + (rkbas (/ 2.0 3.0) coef k mmax + (f2cl-lib:array-slice asave double-float (1 3) ((1 28) (1 4))) + dummy 0) + (rkbas (/ 5.0 6.0) coef k mmax + (f2cl-lib:array-slice asave double-float (1 4) ((1 28) (1 4))) + dummy 0) + (go end_label) + end_label + (return (values nil nil nil)))))))) (in-package #-gcl #:cl-user #+gcl "CL-USER") #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or)) Index: contrl.lisp =================================================================== RCS file: /cvsroot/maxima/maxima/share/colnew/lisp/contrl.lisp,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- contrl.lisp 26 May 2010 13:48:19 -0000 1.3 +++ contrl.lisp 26 May 2010 19:49:47 -0000 1.4 @@ -1,5 +1,5 @@ ;;; Compiled by f2cl version: -;;; ("f2cl1.l,v 1.220 2010/05/26 03:22:59 rtoy Exp $" +;;; ("f2cl1.l,v 1.221 2010/05/26 19:25:52 rtoy Exp $" ;;; "f2cl2.l,v 1.37 2008/02/22 22:19:33 rtoy Exp $" ;;; "f2cl3.l,v 1.6 2008/02/22 22:19:33 rtoy Exp $" ;;; "f2cl4.l,v 1.7 2008/02/22 22:19:34 rtoy Exp $" @@ -58,824 +58,732 @@ (ltol colest-ltol) (ntol (aref (colest-part-1 *colest-common-block*) 80))) (f2cl-lib:with-multi-array-data - ((xi double-float xi-%data% xi-%offset%) [...1526 lines suppressed...] + nil + nil + nil + nil + nil + nil + nil + nil + nil + nil + nil + iflag + nil + nil + nil + nil + nil))))))) (in-package #-gcl #:cl-user #+gcl "CL-USER") #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or)) Index: daxpy.lisp =================================================================== RCS file: /cvsroot/maxima/maxima/share/colnew/lisp/daxpy.lisp,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- daxpy.lisp 26 May 2010 13:48:19 -0000 1.3 +++ daxpy.lisp 26 May 2010 19:49:47 -0000 1.4 @@ -1,5 +1,5 @@ ;;; Compiled by f2cl version: -;;; ("f2cl1.l,v 1.220 2010/05/26 03:22:59 rtoy Exp $" +;;; ("f2cl1.l,v 1.221 2010/05/26 19:25:52 rtoy Exp $" ;;; "f2cl2.l,v 1.37 2008/02/22 22:19:33 rtoy Exp $" ;;; "f2cl3.l,v 1.6 2008/02/22 22:19:33 rtoy Exp $" ;;; "f2cl4.l,v 1.7 2008/02/22 22:19:34 rtoy Exp $" @@ -22,118 +22,101 @@ (type (double-float) da) (type (f2cl-lib:integer4) incy incx n)) (f2cl-lib:with-multi-array-data - ((dx double-float dx-%data% dx-%offset%) - (dy double-float dy-%data% dy-%offset%)) - (prog ((i 0) (ix 0) (iy 0) (m 0) (mp1 0)) - (declare (type (f2cl-lib:integer4) mp1 m iy ix i)) - (if (<= n 0) (go end_label)) - (if (= da 0.0) (go end_label)) - (if (and (= incx 1) (= incy 1)) (go label20)) - (setf ix 1) - (setf iy 1) - (if (< incx 0) - (setf ix - (f2cl-lib:int-add - (f2cl-lib:int-mul (f2cl-lib:int-sub 1 n) incx) - 1))) - (if (< incy 0) - (setf iy - (f2cl-lib:int-add - (f2cl-lib:int-mul (f2cl-lib:int-sub 1 n) incy) - 1))) - (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) - ((> i n) nil) - (tagbody - (setf (f2cl-lib:fref dy-%data% (iy) ((1 *)) dy-%offset%) - (+ - (f2cl-lib:fref dy-%data% - (iy) - ((1 *)) - dy-%offset%) - (* da - (f2cl-lib:fref dx-%data% - (ix) - ((1 *)) - dx-%offset%)))) - (setf ix (f2cl-lib:int-add ix incx)) - (setf iy (f2cl-lib:int-add iy incy)) - label10)) - (go end_label) - label20 - (setf m (mod n 4)) - (if (= m 0) (go label40)) - (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) - ((> i m) nil) - (tagbody - (setf (f2cl-lib:fref dy-%data% (i) ((1 *)) dy-%offset%) - (+ - (f2cl-lib:fref dy-%data% (i) ((1 *)) dy-%offset%) - (* da - (f2cl-lib:fref dx-%data% - (i) - ((1 *)) - dx-%offset%)))) - label30)) - (if (< n 4) (go end_label)) - label40 - (setf mp1 (f2cl-lib:int-add m 1)) - (f2cl-lib:fdo (i mp1 (f2cl-lib:int-add i 4)) - ((> i n) nil) - (tagbody - (setf (f2cl-lib:fref dy-%data% (i) ((1 *)) dy-%offset%) - (+ - (f2cl-lib:fref dy-%data% (i) ((1 *)) dy-%offset%) - (* da - (f2cl-lib:fref dx-%data% - (i) - ((1 *)) - dx-%offset%)))) - (setf (f2cl-lib:fref dy-%data% - ((f2cl-lib:int-add i 1)) - ((1 *)) - dy-%offset%) - (+ - (f2cl-lib:fref dy-%data% - ((f2cl-lib:int-add i 1)) - ((1 *)) - dy-%offset%) - (* da - (f2cl-lib:fref dx-%data% - ((f2cl-lib:int-add i 1)) - ((1 *)) - dx-%offset%)))) - (setf (f2cl-lib:fref dy-%data% - ((f2cl-lib:int-add i 2)) - ((1 *)) - dy-%offset%) - (+ - (f2cl-lib:fref dy-%data% - ((f2cl-lib:int-add i 2... [truncated message content] |