Return to array.l CVS log

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

Annotation of 43BSD/ucb/lisp/liszt/array.l, revision 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.