below a patch I intend to apply today evening.
It might be good to have some more options, for common optimization
declarations like
((safety 0) (speed 3))
and
((safety 3) (debug 3) (speed 0))
or some such.
This patch gives full access to the lisp optimize declarations, I think this is
more future-proof.
Martin
Index: configure
===================================================================
--- configure (revision 354)
+++ configure (working copy)
@@ -704,6 +704,7 @@
axiom_eval_flags
axiom_fasl_type
axiom_fasl_type2
+fricas_algebra_optimization
axiom_all_prerequisites
axiom_c_runtime
CPP
@@ -1319,17 +1320,20 @@
Optional Features:
--disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
--enable-FEATURE[=ARG] include FEATURE [ARG=yes]
- --enable-gcl build GCL from FriCAS source
+ --enable-gcl build GCL from FriCAS source
--enable-aldor build an interface to the Aldor compiler
Optional Packages:
--with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
--without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
- --with-included-noweb build noweb from included sources
- --with-lisp=L use L as Lisp platform
- --with-lisp-flavor=F your Lisp is brand F
- where F if one F gcl clisp sbcl ecl openmcl
- gcl clisp sbcl ecl can be autodetected
+ --with-included-noweb build noweb from included sources
+ --with-lisp=L use L as Lisp platform
+ --with-lisp-flavor=F your Lisp is brand F
+ where F if one F gcl clisp sbcl ecl openmcl
+ gcl clisp sbcl ecl can be autodetected
+ --with-algebra-optimization=S
+ use S as Lisp optimize declaration for compiling the
+ algebra
--with-x use the X Window System
Some influential environment variables:
@@ -4118,8 +4122,19 @@
+fricas_algebra_optimization=nil
+# Check whether --with-algebra-optimization was given.
+if test "${with_algebra_optimization+set}" = set; then
+ withval=$with_algebra_optimization; fricas_algebra_optimization=$withval
+fi
+
+
+
+
+
+
# FIXME: Move this out of here.
# The core runtime is always built.
axiom_c_runtime=core
@@ -9581,6 +9596,7 @@
axiom_eval_flags!$axiom_eval_flags$ac_delim
axiom_fasl_type!$axiom_fasl_type$ac_delim
axiom_fasl_type2!$axiom_fasl_type2$ac_delim
+fricas_algebra_optimization!$fricas_algebra_optimization$ac_delim
axiom_all_prerequisites!$axiom_all_prerequisites$ac_delim
axiom_c_runtime!$axiom_c_runtime$ac_delim
CPP!$CPP$ac_delim
@@ -9588,7 +9604,6 @@
EGREP!$EGREP$ac_delim
axiom_c_runtime_extra!$axiom_c_runtime_extra$ac_delim
XMKMF!$XMKMF$ac_delim
-X_CFLAGS!$X_CFLAGS$ac_delim
_ACEOF
if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 97; then
@@ -9630,6 +9645,7 @@
ac_delim='%!_!# '
for ac_last_try in false false false false false :; do
cat >conf$$subs.sed <<_ACEOF
+X_CFLAGS!$X_CFLAGS$ac_delim
X_PRE_LIBS!$X_PRE_LIBS$ac_delim
X_LIBS!$X_LIBS$ac_delim
X_EXTRA_LIBS!$X_EXTRA_LIBS$ac_delim
@@ -9649,7 +9665,7 @@
LTLIBOBJS!$LTLIBOBJS$ac_delim
_ACEOF
- if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 17; then
+ if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 18; then
break
elif $ac_last_try; then
{ { echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5
Index: src/interp/nrunfast.boot
===================================================================
--- src/interp/nrunfast.boot (revision 354)
+++ src/interp/nrunfast.boot (working copy)
@@ -107,9 +107,9 @@
nil
slot := domain.loc
null atom slot =>
- EQ(QCAR slot,'newGoGet) => someMatch:=true
+ EQ(QCAR slot,FUNCTION newGoGet) => someMatch:=true
--treat as if operation were not there
- --if EQ(QCAR slot,'newGoGet) then
+ --if EQ(QCAR slot, function newGoGet) then
-- UNWIND_-PROTECT --break infinite recursion
-- ((SETELT(domain,loc,'skip); slot := replaceGoGetSlot QCDR slot),
-- if domain.loc = 'skip then domain.loc := slot)
Index: src/interp/nlib.lisp
===================================================================
--- src/interp/nlib.lisp (revision 354)
+++ src/interp/nlib.lisp (working copy)
@@ -355,7 +355,14 @@
(apply #'compile-file fn opts))
(untrace compiler::fast-link-proclaimed-type-p compiler::t1defun)))
#-:AKCL
-(define-function 'compile-lib-file #'compile-file)
+(define-function 'compile-lib-file
+ (if FRICAS-LISP::algebra-optimization
+ #'(lambda (f)
+ (locally (proclaim (cons 'optimize
+ FRICAS-LISP::algebra-optimization)))
+ (compile-file f))
+ #'compile-file))
+
;; (RDROPITEMS filearg keys) don't delete, used in files.spad
(defun rdropitems (filearg keys &aux (ctable (getindextable filearg)))
Index: src/interp/nrunopt.boot
===================================================================
--- src/interp/nrunopt.boot (revision 354)
+++ src/interp/nrunopt.boot (working copy)
@@ -175,9 +175,9 @@
stuffSlot(dollar,i,item) ==
dollar.i :=
atom item => [SYMBOL_-FUNCTION item,:dollar]
- item is [n,:op] and INTEGERP n => ['newGoGet,dollar,:item]
+ item is [n,:op] and INTEGERP n => [FUNCTION newGoGet,dollar,:item]
item is ['CONS,.,['FUNCALL,a,b]] =>
- b = '$ => ['makeSpadConstant,eval a,dollar,i]
+ b = '$ => [FUNCTION makeSpadConstant,eval a,dollar,i]
sayBrightlyNT '"Unexpected constant environment!!"
pp devaluate b
nil
Index: src/interp/i-coerce.boot
===================================================================
--- src/interp/i-coerce.boot (revision 354)
+++ src/interp/i-coerce.boot (working copy)
@@ -922,7 +922,7 @@
ml := [target,:margl]
intName :=
or/[mm for mm in mms | (mm is [[., :ml1],oldName,:.]
- and compareTypeLists(ml1,ml))] => [oldName]
+ and compareTypeLists(ml1,ml))] => [COERCE(oldName, 'FUNCTION)]
NIL
null intName => NIL
objNewWrap(intName,t2)
Index: src/interp/interop.boot
===================================================================
--- src/interp/interop.boot (revision 354)
+++ src/interp/interop.boot (working copy)
@@ -350,7 +350,7 @@
PAIRP a and VECP(CAR a) and
member(CAR(a).0, $domainTypeTokens)
--- following is interpreter interfact to function lookup
+-- following is interpreter interface to function lookup
-- perhaps it should always work with hashcodes for signature?
--------------------> NEW DEFINITION (override in nrungo.boot.pamphlet)
NRTcompiledLookup(op,sig,dom) ==
@@ -574,9 +574,9 @@
nil
slot := domain.loc
null atom slot =>
- EQ(QCAR slot,'newGoGet) => someMatch:=true
+ EQ(QCAR slot,FUNCTION newGoGet) => someMatch:=true
--treat as if operation were not there
- --if EQ(QCAR slot,'newGoGet) then
+ --if EQ(QCAR slot, function newGoGet) then
-- UNWIND_-PROTECT --break infinite recursion
-- ((SETELT(domain,loc,'skip); slot := replaceGoGetSlot QCDR slot),
-- if domain.loc = 'skip then domain.loc := slot)
@@ -838,7 +838,8 @@
u is ['ELT,d,n] =>
dom := evalSlotDomain(d,dollar)
slot := dom . n
- slot is ['newGoGet,:env] => replaceGoGetSlot env
+ slot is [=FUNCTION newGoGet,:env] =>
+ replaceGoGetSlot env
slot
u is [op,:argl] => APPLY(op,[evalSlotDomain(x,dollar) for x in argl])
systemErrorHere '"evalSlotDomain"
Index: src/interp/macros.lisp
===================================================================
--- src/interp/macros.lisp (revision 354)
+++ src/interp/macros.lisp (working copy)
@@ -838,10 +838,17 @@
(defmacro SPADCONST (&rest L) (cons 'qrefelt L))
(defmacro SPADCALL (&rest L)
- (let ((args (butlast l)) (fn (car (last l))) (gi (gensym)))
+ (let ((args (butlast l))
+ (fn (car (last l)))
+ (gi (gensym)))
;; (values t) indicates a single return value
- `(let ((,gi ,fn)) (the (values t) (funcall (car ,gi) ,@args (cdr ,gi))))
- ))
+ `(let ((,gi ,fn))
+ (the (values t)
+ (funcall
+ (the (function ,(make-list (length l) :initial-element t) t)
+ (car ,gi))
+ ,@args
+ (cdr ,gi))))))
(defun LISTOFATOMS (X)
(COND ((NULL X) NIL)
Index: src/interp/br-op1.boot
===================================================================
--- src/interp/br-op1.boot (revision 354)
+++ src/interp/br-op1.boot (working copy)
@@ -951,9 +951,9 @@
cell := compiledLookup(op,sig1,dom) =>
[f,:r] := cell
f = 'nowhere => 'nowhere --see replaceGoGetSlot
- f = 'makeSpadConstant => 'constant
+ f = function makeSpadConstant => 'constant
f = function IDENTITY => 'constant
- f = 'newGoGet => SUBST('_$,domname,devaluate CAR r)
+ f = function newGoGet => SUBST('_$,domname,devaluate CAR r)
null VECP r => systemError devaluateList r
SUBST('_$,domname,devaluate r)
'nowhere
Index: src/interp/i-eval.boot
===================================================================
--- src/interp/i-eval.boot (revision 354)
+++ src/interp/i-eval.boot (working copy)
@@ -293,12 +293,14 @@
a.0 := name
mmS := selectLocalMms(a,name,rest ml, nil)
or/[mm for mm in mmS |
- (mm is [[., :ml1],oldName,:.] and ml=ml1)] => MKQ [oldName]
+ (mm is [[., :ml1],oldName,:.] and ml=ml1)] =>
+ MKQ [COERCE(oldName, 'FUNCTION)]
NIL
una
mmS := selectLocalMms(a,una,rest ml, nil)
or/[mm for mm in mmS |
- (mm is [[., :ml1],oldName,:.] and ml=ml1)] => MKQ [oldName]
+ (mm is [[., :ml1],oldName,:.] and ml=ml1)] =>
+ MKQ [COERCE(oldName, 'FUNCTION)]
NIL
getArgValueComp2(arg, type, cond, se?, opName) ==
Index: src/interp/showimp.boot
===================================================================
--- src/interp/showimp.boot (revision 354)
+++ src/interp/showimp.boot (working copy)
@@ -226,7 +226,7 @@
showGoGet dom ==
numvec := CDDR dom.4
- for i in 6..MAXINDEX dom | (slot := dom.i) is ['newGoGet,dol,index,:op]
repeat
+ for i in 6..MAXINDEX dom | (slot := dom.i) is [=FUNCTION
newGoGet,dol,index,:op] repeat
numOfArgs := numvec.index
whereNumber := numvec.(index := index + 1)
signumList :=
Index: src/interp/i-spec1.boot
===================================================================
--- src/interp/i-spec1.boot (revision 354)
+++ src/interp/i-spec1.boot (working copy)
@@ -206,8 +206,8 @@
--
-- MCD 13/3/96
if not $definingMap and ($genValue or $compilingMap) then
- fun := [$mapName,['LAMBDA,[:vars,'envArg],body]]
- code := wrap compileInteractive fun
+ fun := compileInteractive [$mapName,['LAMBDA,[:vars,'envArg],body]]
+ code := wrap RPLACA(fun, SYMBOL_-FUNCTION CAR fun)
else
$freeVariables := []
$boundVariables := [minivectorName,:vars]
Index: src/lisp/Makefile.in
===================================================================
--- src/lisp/Makefile.in (revision 354)
+++ src/lisp/Makefile.in (working copy)
@@ -36,9 +36,10 @@
$(OUT)/lisp$(EXEEXT): do_it.$(lisp_flavor)
-do_it.gcl: fricas-lisp.lisp fricas-package.lisp
+do_it.gcl: fricas-lisp.lisp fricas-package.lisp fricas-config.lisp
@axiom_gcl_rsym_hack@
- echo '(load "fricas-package.lisp") (load "fricas-lisp.lisp")' \
+ echo '(load "fricas-package.lisp") (load "fricas-config.lisp")' \
+ '(load "fricas-lisp.lisp")' \
'(setq compiler::*default-system-p* t)' \
'(compile-file "fricas-lisp.lisp")' | $(FRICAS_LISP)
echo '(compiler::link nil "prelisp" ' \
@@ -51,7 +52,8 @@
' si::*system-directory* (quote (list ".lsp")))' \
' "$(lisp_c_objects) @axiom_c_runtime_extra@")' \
| $(FRICAS_LISP)
- echo '(load "fricas-package.lisp") (load "fricas-lisp.$(OBJEXT)")' \
+ echo '(load "fricas-package.lisp") (load "fricas-config.lisp")' \
+ '(load "fricas-lisp.$(OBJEXT)")' \
'(in-package "FRICAS-LISP") (save-core "$(OUT)/lisp$(EXEEXT)")' \
| ./prelisp$(EXEEXT)
$(STAMP) $@
@@ -62,29 +64,38 @@
fricas-package.lisp: $(srcdir)/fricas-package.lisp
cp $< $@
-do_it.ecl: fricas-lisp.lisp fricas-package.lisp
+fricas-config.lisp:
+ echo '(in-package "FRICAS-LISP")' > $@
+ echo '(defparameter algebra-optimization' \
+ '(quote @fricas_algebra_optimization@))' >> $@
+
+do_it.ecl: fricas-lisp.lisp fricas-package.lisp fricas-config.lisp
echo "(in-package \"FRICAS-LISP\")" > fricas-ecl.lisp
echo "(defvar *fricas-extra-c-files* (quote (" \
$(patsubst %, "\"%\"", $(lisp_c_objects)) \
")))" >> fricas-ecl.lisp
echo "(defvar *fricas-initial-lisp-objects* (quote (" \
$(patsubst %, "\"$(BASE)$(abs_builddir)/%\"", \
- fricas-package.o fricas-ecl.o fricas-lisp.o) ")))" \
+ fricas-package.o fricas-config.o fricas-ecl.o \
+ fricas-lisp.o) ")))" \
>> fricas-ecl.lisp
echo "(defvar *fricas-initial-lisp-forms* nil)" >> fricas-ecl.lisp
echo '(load "fricas-package.lisp")' \
+ '(load "fricas-config.lisp")' \
'(load "fricas-ecl.lisp")' \
'(load "fricas-lisp.lisp")' \
'(in-package "FRICAS-LISP")' \
- '(fricas-compile-file "fricas-package.lisp")' \
+ '(fricas-compile-file "fricas-package.lisp")' \
+ '(fricas-compile-file "fricas-config.lisp")' \
'(fricas-compile-file "fricas-ecl.lisp")' \
'(fricas-compile-file "fricas-lisp.lisp")' \
'(make-program "${OUT}/lisp" nil)' | $(FRICAS_LISP)
$(STAMP) $@
-
-do_it.sbcl do_it.clisp do_it.openmcl: fricas-lisp.lisp fricas-package.lisp
+do_it.sbcl do_it.clisp do_it.openmcl: fricas-lisp.lisp fricas-package.lisp \
+ fricas-config.lisp
echo '(load "fricas-package.lisp")' \
+ '(load "fricas-config.lisp")' \
'(load (compile-file "fricas-lisp.lisp"))' \
'(in-package "FRICAS-LISP") (save-core "${OUT}/lisp")' \
| $(FRICAS_LISP)
Index: configure.ac
===================================================================
--- configure.ac (revision 354)
+++ configure.ac (working copy)
@@ -135,7 +135,7 @@
axiom_build_noweb=
AC_ARG_WITH([included-noweb],
- [ --with-included-noweb build noweb from included sources],
+ [ --with-included-noweb build noweb from included sources],
[case $withval in
yes) if test -f "$axiom_top_srcdir/zips/noweb-2.10a.tgz" ; then
axiom_build_noweb=yes
@@ -180,12 +180,14 @@
## We will default to GCL later, if no lisp implementation is specified.
fricas_lisp=
fricas_lisp_flavor=unknown
-AC_ARG_WITH([lisp], [ --with-lisp=L use L as Lisp platform],
+AC_ARG_WITH([lisp],
+ [ --with-lisp=L use L as Lisp platform],
[fricas_lisp=$withval])
## If --enable-gcl is specified, we need to check for coonsistency
axiom_include_gcl=
if test -z $fricas_lisp ; then
- AC_ARG_ENABLE([gcl], [ --enable-gcl build GCL from FriCAS source],
+ AC_ARG_ENABLE([gcl],
+ [ --enable-gcl build GCL from FriCAS source],
[case $enableval in
yes|no) axiom_include_gcl=$enableval ;;
*) AC_MSG_ERROR([erroneous value for --enable-gcl]) ;;
@@ -230,9 +232,9 @@
esac
AC_ARG_WITH([lisp-flavor],
- [ --with-lisp-flavor=F your Lisp is brand F
- where F if one F gcl clisp sbcl ecl openmcl
- gcl clisp sbcl ecl can be autodetected],
+ [ --with-lisp-flavor=F your Lisp is brand F
+ where F if one F gcl clisp sbcl ecl openmcl
+ gcl clisp sbcl ecl can be autodetected],
[case $withval in
gcl|clisp|sbcl|ecl|openmcl)
fricas_lisp_flavor=$withval
@@ -359,6 +361,16 @@
AC_SUBST(axiom_fasl_type)
AC_SUBST(axiom_fasl_type2)
+fricas_algebra_optimization=nil
+
+AC_ARG_WITH([algebra-optimization],
+ [ --with-algebra-optimization=S
+ use S as Lisp optimize declaration for compiling the
+ algebra],
+ [fricas_algebra_optimization=$withval])
+
+AC_SUBST(fricas_algebra_optimization)
+
AC_SUBST(axiom_all_prerequisites)
# FIXME: Move this out of here.
--~--~---------~--~----~------------~-------~--~----~
You received this message because you are subscribed to the Google Groups
"FriCAS - computer algebra system" group.
To post to this group, send email to [email protected]
To unsubscribe from this group, send email to [EMAIL PROTECTED]
For more options, visit this group at
http://groups.google.com/group/fricas-devel?hl=en
-~----------~----~----~----~------~----~------~--~---
