Commit b3314329 authored by Raymond Toy's avatar Raymond Toy

Fix issues discovered when updating maxima to lapack 3.4.2.:

o Did not handle the declaration correctly:

     character name*(*)

  This was declaring name to be an array of strings, but it's really
  just a string of unknown length.
o Added new (Fortran 95) intrinsic LEN_TRIM.  This was needed by the
  new version of lapack.
o Try to be more careful about declaring things that were declared as
  instrinsics.  We no longer create a dummy variable named foo$ when
  we foo is declared as a intrinsic.
parent 8f97b612
-*- Mode: text -*-
Changes:
Mar 2013
--------
Some updates needed to when trying to update to LaPACK 3.4.2 in
maxima.
o Did not handle the declaration correctly:
character name*(*)
This was declaring name to be an array of strings, but it's really
just a string of unknown length.
o Added new (Fortran 95) intrinsic LEN_TRIM. This was needed by the
new version of lapack.
o Try to be more careful about declaring things that were declared as
instrinsics. We no longer create a dummy variable named foo$ when
we foo is declared as a intrinsic.
May 2012
--------
o Ecl has a interesting feature in its compiler where the type of a
......
......@@ -48,6 +48,7 @@
#:max1 #:min0 #:min1 #:nint #:freal
#:sign #:sngl #:fsqrt
#:cdabs #:dconjg
#:len_trim
;; other functions
#:d1mach #:r1mach #:i1mach
))
......@@ -66,7 +67,7 @@
;;;-------------------------------------------------------------------------
;;; end of f2cl0.l
;;;
;;; $Id: f2cl0.l,v db7ba752d7ac 2010/02/23 00:59:12 rtoy $
;;; $Id: f2cl0.l,v 1409c1352feb 2013/03/24 20:44:50 toy $
;;; $Log$
;;; Revision 1.25 2010/02/23 00:59:12 rtoy
;;; Support the Fortran capability of passing an array of one type
......
......@@ -17,7 +17,7 @@
"Use (f2cl-version) instead")
(defparameter *f2cl1-version*
"$Id: f2cl1.l,v 2edcbd958861 2012/05/30 03:34:52 toy $")
"$Id: f2cl1.l,v 1409c1352feb 2013/03/24 20:44:50 toy $")
;; Forward declarations.
(defvar *f2cl2-version*)
......@@ -51,6 +51,7 @@
zsqrt
cdabs dconjg
dfloat
len_trim
)
"A list of all the intrinsic functions in Fortran 77")
......@@ -101,7 +102,8 @@
(eval-when (compile load eval)
(proclaim '(special *sentable*))
(proclaim '(special *external-function-names*
(proclaim '(special
*external-function-names*
*undeclared_vbles* *declared_vbles* *implicit_vble_decls*
*subprog-arglist* *data-init*
*explicit_vble_decls* *function-flag* *key_params*
......@@ -127,6 +129,7 @@
*parsing-lhs*
;; List of statement labels in a subprogram
*statement-labels*
*declared-intrinsic-names*
)))
(defvar *common-blocks* (make-hash-table)
......@@ -1093,6 +1096,7 @@ correctly"
*parsing-lhs*
*equivalenced-vars*
*common_array_dims*
*declared-intrinsic-names*
)
(print-header outport declaim package options)
......@@ -1336,7 +1340,7 @@ correctly"
(return (parse-save x)))
;;intrinsic
(when (eq (car x) 'intrinsic)
(return nil))
(return (parse-intrinsic x)))
;;external
(when (eq (car x) 'external)
(return (parse-external x)))
......@@ -2604,6 +2608,7 @@ correctly"
;; character a*10, b*20, c*30
;; character*10 x(10), y(20), z(3,4)
;; character x(10)*10, y(20)*7, z(3,4)*8
;; character x*(*)
;;
;; By the time we get these, the line looks something like the
;; following, respectively:
......@@ -2612,6 +2617,7 @@ correctly"
;; character a * 10 |,| b * 20 |,| c * 30
;; character * 10 x(10) |,| y(20) |,| z(3 |,| 4)
;; character x(10) * 10 |,| y(20) * 7 |,| z(3 |,| 4) * 8
;; character x * (*)
(defun parse-char-decl (x)
;; x is the line.
......@@ -2635,15 +2641,24 @@ correctly"
;; The length may have been given as part of the variable.
;; Put the length with the variable type.
(mapc #'(lambda (decl)
(destructuring-bind (name &optional dim-or-len &rest len)
(remove '* decl)
(push
(if (and dim-or-len (listp dim-or-len))
;; An array
`((character ,@len) (,name ,@(parse_dimension_specs dim-or-len)))
;; A simple character string
`((character ,(or dim-or-len 1)) (,name)))
*explicit_vble_decls*)))
(cond
((eq (second decl) '*)
;; Decl is something like name*(*) so we had
;; something like
;; character name*(*)
;; This is a character string of unknown length
(push `((character ,(or (third decl) 1)) (,(first decl)))
*explicit_vble_decls*))
(t
(destructuring-bind (name &optional dim-or-len &rest len)
(remove '* decl)
(push
(if (and dim-or-len (listp dim-or-len))
;; An array
`((character ,@len) (,name ,@(parse_dimension_specs dim-or-len)))
;; A simple character string
`((character ,(or dim-or-len 1)) (,name)))
*explicit_vble_decls*)))))
(list-split '|,| (cdr x)))))
;;(format t "explicit_vble_decls* = ~A~%" *explicit_vble_decls*)
......@@ -2920,6 +2935,13 @@ correctly"
(append *external-function-names* (remove '|,| (cdr x))))
nil)
;; parse INTRINSIC f1, f2
;; by adding the function names to *declared-intrinsic-names*
(defun parse-intrinsic (x)
(setf *declared-intrinsic-names*
(append *declared-intrinsic-names* (remove '|,| (cdr x))))
nil)
;; parse EQUIVALENCE (x1,y1), (x2, y2), ...
#+nil
(defun parse-equivalence (x)
......@@ -3352,7 +3374,7 @@ loop2
;;;-----------------------------------------------------------------------------
;;; end of f2cl1.l
;;;
;;; $Id: f2cl1.l,v 2edcbd958861 2012/05/30 03:34:52 toy $
;;; $Id: f2cl1.l,v 1409c1352feb 2013/03/24 20:44:50 toy $
;;; $Log$
;;; Revision 1.222 2010/10/08 03:05:30 rtoy
;;; src/f2cl1.l:
......
......@@ -50,7 +50,7 @@
(in-package :f2cl)
(defparameter *f2cl5-version*
"$Id: f2cl5.l,v f6a99aceabfe 2013/03/17 18:35:36 toy $")
"$Id: f2cl5.l,v 1409c1352feb 2013/03/24 20:44:50 toy $")
;; functions for setting up varaible declarations and initialisations
(eval-when (compile load eval)
......@@ -2758,7 +2758,9 @@
(not (eq access :internal))
(fboundp found-it))
(member x +reserved-lisp-names+)
(eq :external (nth-value 1 (find-symbol (symbol-name x) :f2cl-lib))))
(and (eq :external (nth-value 1 (find-symbol (symbol-name x) :f2cl-lib)))
(member x *intrinsic-function-names*)
(not (member x *declared-intrinsic-names*))))
;; We want to append "$" for certain cases to prevent
;; collisions. (Any character can be used. But we can't
;; prepend because f2cl wants to look at the first
......@@ -2766,8 +2768,9 @@
;;
;; 1. External functions in the common-lisp package.
;;
;; 2. External symbols in the f2cl-lib package. (Not
;; strictly necessary, but does make the code nicer).
;; 2. External symbols in the f2cl-lib package. But if
;; they're intrinsics and declared as intrinsics, we
;; don't need to.
(intern (concatenate 'string (string x) "$")))
(t
x))))
......@@ -3873,7 +3876,7 @@
;;;-----------------------------------------------------------------------------
;;; end of f2cl5.l
;;;
;;; $Id: f2cl5.l,v f6a99aceabfe 2013/03/17 18:35:36 toy $
;;; $Id: f2cl5.l,v 1409c1352feb 2013/03/24 20:44:50 toy $
;;; $Log$
;;; Revision 1.204 2010/02/23 05:21:30 rtoy
;;; Fix declaration for default integer type. Previously the type was
......
......@@ -6,7 +6,7 @@
(in-package :f2cl-lib)
(defparameter *f2cl-macros-version*
"$Id: macros.l,v 3fe93de3be82 2012/05/06 02:17:14 toy $")
"$Id: macros.l,v 1409c1352feb 2013/03/24 20:44:50 toy $")
(eval-when
#+gcl (compile load eval)
......@@ -752,6 +752,18 @@ is not included")
(defun len (s)
(length s))
;; Fortran 95
;; Length of a character entity without trailing blank characters
(defun len_trim (s)
;; Find the position of the last blank. If there is one, then the
;; length is one more than that. Otherwise, the length is 0.
(let ((p (position-if #'(lambda (c)
(char/= c #\space))
s)))
(if p
(1+ p)
0)))
;; From http://www.fortran.com/fortran/F77_std/rjcnf0001-sh-15.html#sh-15.10:
;;
;; INDEX(a1 ,a2) returns an integer value indicating the starting
......@@ -1553,7 +1565,7 @@ causing all pending operations to be flushed"
;;;-------------------------------------------------------------------------
;;; end of macros.l
;;;
;;; $Id: macros.l,v 3fe93de3be82 2012/05/06 02:17:14 toy $
;;; $Id: macros.l,v 1409c1352feb 2013/03/24 20:44:50 toy $
;;; $Log$
;;; Revision 1.117 2011/02/28 22:21:07 rtoy
;;; When opening an old file, we should set :if-exists to :overwrite to
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment