BSD 4_4 development

Work on file usr/src/old/lisp/liszt/array.l

Synthesized-from: CSRG/cd3/4.4

diff --git a/usr/src/old/lisp/liszt/array.l b/usr/src/old/lisp/liszt/array.l
new file mode 100644 (file)
index 0000000..7c30f78
--- /dev/null
+++ b/usr/src/old/lisp/liszt/array.l
@@ -0,0 +1,74 @@
+(include-if (null (get 'chead 'version)) "../chead.l")
+(Liszt-file array
+   "$Header: array.l,v 1.7 83/08/28 17:12:39 layer Exp $")
+
+;;; ----       a r r a y                       array referencing
+;;;
+;;;                            -[Sat Aug  6 23:59:45 1983 by layer]-
+
+
+;--- d-handlearrayref :: general array handler
+; this function is called from d-exp when the car is an array (declare macarray)
+; In the current array scheme, stores look like array references with one
+; extra argument. Thus we must determine if we are accessing or storing in
+; the array.
+; Note that we must turn g-loc to reg and g-cc to nil since, even though
+; d-supercxr handles g-loc and g-cc, d-superrplacx does not and we cannot
+; know ahead of time which one we will use.  If this seems important,
+; we can beef up d-superrplacx
+;
+(defun d-handlearrayref nil
+  (let ((spec (get (car v-form) g-arrayspecs))
+       expr
+       (g-loc 'reg)  g-cc)
+
+       (makecomment '(array ref))
+       (if (eq (1+ (length (cdr spec))) (length (cdr v-form)))
+          then (d-dostore spec (cadr v-form) (cddr v-form))
+          else (setq expr (d-arrayindexcomp (cdr v-form) (cdr spec)))
+
+               (let ((v-form `(cxr ,expr (getdata (getd ',(car v-form))))))
+                    (d-supercxr (car spec) nil)))))
+
+
+;--- d-dostore :: store value in array.
+;      spec - array descriptor from declare, e.g. (foo t 12 3 4)
+;      value - expression to calculate value to be stored.
+;      indexes - list of expressions which are the actual indicies.
+;
+(defun d-dostore (spec value indexes)
+  (let (expr gen)
+       (makecomment '(doing store))
+       ; create an expression for doing index calculation.
+       (setq expr (d-arrayindexcomp indexes (cdr spec))
+            gen  (gensym))
+
+       ; calculate value to store and stack it.
+       (d-pushargs (ncons value))
+       (rplaca g-locs gen)     ; name just stacked varib
+
+       ; do the store operation.
+       (let ((v-form `(rplacx ,expr (getdata (getd ',(car v-form)))
+                             ,gen)))
+           (d-superrplacx (car spec)))
+
+       ; move the value we stored into r0
+       (d-move 'unstack 'reg)
+       (setq g-locs (cdr g-locs))
+       (decr g-loccnt)))
+
+
+
+
+(defun d-arrayindexcomp (actual formal)
+  (if (null (cdr actual))
+      then (car actual)        ; always allow one arg
+   elseif  (eq (length actual) (length formal))
+      then (do ((ac actual (cdr ac))
+               (fo formal (cdr fo))
+               (res))
+              ((null ac) (cons '+ res))
+              (setq res (cons (if (null (cdr fo)) then (car ac)
+                                  else `(* ,(car ac) ,(apply 'times (cdr fo))))
+                              res)))
+   else (comp-err "Wrong number of subscripts to array " actual)))