share/contrib/state/readfile.lisp

   1 ;;;These subroutines do some low level input and utility stuff
   2 ;;;Copyright (C) 1999  Dan Stanger
   3 ;;;
   4 ;;;This library is free software; you can redistribute it and/or modify it
   5 ;;;under the terms of the GNU Library General Public License as published
   6 ;;;by the Free Software Foundation; either version 2 of the License, or (at
   7 ;;;your option) any later version.
   8 ;;;
   9 ;;;This library is distributed in the hope that it will be useful, but
  10 ;;;WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ;;;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12 ;;;Library General Public License for more details.
  13 ;;;
  14 ;;;You should have received a copy of the GNU Library General Public
  15 ;;;License along with this library; if not, write to the Free Software
  16 ;;;Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA
  17 ;;;
  18 ;;;Dan Stanger dan.stanger@eee.org
  19
  20 ; this constant is used to order the elements for the proper tree
  21 ; algorithm.
  22 (defconstant *circuit-elements*
  23    (make-array 6 :initial-contents
  24      '((#\1 . $unknown) (#\V . $vsource) (#\C . $capacitor) (#\R . $resistor)
  25        (#\L . $inductor)
  26        (#\I . $isource))))
  27
  28 ; this constant is used to order the tree elements for the state equation
  29 (defconstant *circuit-elements-tree*
  30    (make-array 4 :initial-contents
  31      '($unknown $capacitor $resistor $vsource)))
  32
  33 ;this constant is used to order the link elements for the state equation
  34 (defconstant *circuit-elements-link*
  35    (make-array 4 :initial-contents
  36      '($unknown $inductor $resistor $isource)))
  37
  38 (defun process-type (s)
  39    (let* ((sn (symbol-name s))
  40           (p (position (char sn 0) *circuit-elements* :key #'first )))
  41       (if (null p) '$unknown (cdr (aref *circuit-elements* p)))))
  42
  43 (DEFMTRFUN (|$getElementIndex| $ANY MDEFINE NIL NIL)
  44            ($E)
  45            (DECLARE (SPECIAL $E))
  46            (let ((p (position $E *circuit-elements* :key #'cdr)))
  47                 (if (null p) (error "invalid value in getelementindex") p)))
  48
  49 (DEFMTRFUN (|$getTreeElementIndex| $ANY MDEFINE NIL NIL)
  50            ($E)
  51            (DECLARE (SPECIAL $E))
  52            (let ((p (position $E *circuit-elements-tree*)))
  53                 (if (null p) (error "invalid value in gettreeelementindex") p)))
  54
  55 (DEFMTRFUN (|$getLinkElementIndex| $ANY MDEFINE NIL NIL)
  56            ($E)
  57            (DECLARE (SPECIAL $E))
  58            (let ((p (position $E *circuit-elements-link*)))
  59                 (if (null p) (error "invalid value in getlinkelementindex") p)))
  60
  61 (defun process-line (l)
  62    (let* ((st (make-string-input-stream l)) (ty (read st))
  63           (from (read st)) (to (read st)) (ex (read-line st nil nil)))
  64    (list (quote (mlist))
  65       (intern-invert-case (concatenate 'string "$" (string ty)))
  66       (process-type ty)
  67       from
  68       to
  69       (when ex ($eval_string (intern-invert-case (concatenate 'string "&" (string ex))))))))
  70
  71 (DEFMTRFUN ($readfile $ANY MDEFINE NIL NIL)
  72            ($FILENAME)
  73            ((LAMBDA ($A)
  74 (with-open-file
  75     (l (print-invert-case (stripdollar $filename))
  76        :direction :input :if-does-not-exist :error)
  77    (do ((line   (read-line l nil nil)
  78                 (read-line l nil nil)))
  79         ((not line) (return nil))
  80         (setq $a ($cons
  81                         (process-line line)
  82                         $a))
  83    ))
  84                     $A)
  85             (LIST (QUOTE (MLIST)))))
  86