Return to array.l CVS log

Up to [CSRG BSD Unix] / 43BSDTahoe / ucb / lisp / liszt

Annotation of 43BSDTahoe/ucb/lisp/liszt/array.l, revision 1.1.1.1

1.1       root        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)))

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.