home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / bsd_srcs / usr.bin / lisp / liszt / array.l next >
Encoding:
Text File  |  1983-08-28  |  2.5 KB  |  75 lines
  1. (include-if (null (get 'chead 'version)) "../chead.l")
  2. (Liszt-file array
  3.    "$Header: array.l,v 1.7 83/08/28 17:12:39 layer Exp $")
  4.  
  5. ;;; ----    a r r a y            array referencing
  6. ;;;
  7. ;;;                -[Sat Aug  6 23:59:45 1983 by layer]-
  8.  
  9.  
  10. ;--- d-handlearrayref :: general array handler
  11. ; this function is called from d-exp when the car is an array (declare macarray)
  12. ; In the current array scheme, stores look like array references with one
  13. ; extra argument. Thus we must determine if we are accessing or storing in
  14. ; the array.
  15. ; Note that we must turn g-loc to reg and g-cc to nil since, even though
  16. ; d-supercxr handles g-loc and g-cc, d-superrplacx does not and we cannot
  17. ; know ahead of time which one we will use.  If this seems important,
  18. ; we can beef up d-superrplacx
  19. ;
  20. (defun d-handlearrayref nil
  21.   (let ((spec (get (car v-form) g-arrayspecs))
  22.     expr
  23.     (g-loc 'reg)  g-cc)
  24.  
  25.        (makecomment '(array ref))
  26.        (if (eq (1+ (length (cdr spec))) (length (cdr v-form)))
  27.        then (d-dostore spec (cadr v-form) (cddr v-form))
  28.        else (setq expr (d-arrayindexcomp (cdr v-form) (cdr spec)))
  29.  
  30.             (let ((v-form `(cxr ,expr (getdata (getd ',(car v-form))))))
  31.              (d-supercxr (car spec) nil)))))
  32.  
  33.  
  34. ;--- d-dostore :: store value in array.
  35. ;    spec - array descriptor from declare, e.g. (foo t 12 3 4)
  36. ;    value - expression to calculate value to be stored.
  37. ;    indexes - list of expressions which are the actual indicies.
  38. ;
  39. (defun d-dostore (spec value indexes)
  40.   (let (expr gen)
  41.        (makecomment '(doing store))
  42.        ; create an expression for doing index calculation.
  43.        (setq expr (d-arrayindexcomp indexes (cdr spec))
  44.          gen  (gensym))
  45.  
  46.        ; calculate value to store and stack it.
  47.        (d-pushargs (ncons value))
  48.        (rplaca g-locs gen)    ; name just stacked varib
  49.  
  50.        ; do the store operation.
  51.        (let ((v-form `(rplacx ,expr (getdata (getd ',(car v-form)))
  52.                   ,gen)))
  53.         (d-superrplacx (car spec)))
  54.  
  55.        ; move the value we stored into r0
  56.        (d-move 'unstack 'reg)
  57.        (setq g-locs (cdr g-locs))
  58.        (decr g-loccnt)))
  59.  
  60.  
  61.  
  62.  
  63. (defun d-arrayindexcomp (actual formal)
  64.   (if (null (cdr actual))
  65.       then (car actual)    ; always allow one arg
  66.    elseif  (eq (length actual) (length formal))
  67.       then (do ((ac actual (cdr ac))
  68.         (fo formal (cdr fo))
  69.         (res))
  70.            ((null ac) (cons '+ res))
  71.            (setq res (cons (if (null (cdr fo)) then (car ac)
  72.                    else `(* ,(car ac) ,(apply 'times (cdr fo))))
  73.                    res)))
  74.    else (comp-err "Wrong number of subscripts to array " actual)))
  75.