;;; -*- cold-load:t; Mode:Common-Lisp; Package:SYSTEM-INTERNALS; Fonts:(CPTFONT CPTFONTB); Base:10. -*-


;;;                           RESTRICTED RIGHTS LEGEND

;;;Use, duplication, or disclosure by the Government is subject to
;;;restrictions as set forth in subdivision (c)(1)(ii) of the Rights in
;;;Technical Data and Computer Software clause at 52.227-7013.
;;;
;;;                     TEXAS INSTRUMENTS INCORPORATED.
;;;                              P.O. BOX 2909
;;;                           AUSTIN, TEXAS 78769
;;;                                 MS 2151
;;;
;;; Copyright (C) 1986-1989 Texas Instruments Incorporated.  All rights reserved.

;;;(Defsubst ELT (sequence index) (sys:COMMON-LISP-ELT sequence index))

(Defsubst FILL-POINTER (ARRAY)
  "Return the fill pointer of ARRAY."
  (ARRAY-LEADER ARRAY 0))

;; DO nothing fancy here...this can be run before crash list processed
(Defsubst SIMPLE-VECTOR-SIZE-P (size)
  "returns t if size is candidate for size of a simple array"
  (AND (FIXNUMP size) (<= 0 size) (<= size %array-max-simple-index-length)))

(Defmacro zlc:store (array-reference value)
  (LET* ((ARRAYCALL (MACROEXPAND array-reference)))
    (CASE (CAR arraycall)
      (FUNCALL `(ZLC:ASET ,value ,(CADR arraycall) . ,(CDDR arraycall)))
      (ARRAYCALL `(ZLC:ASET ,value ,(CADDR arraycall) . ,(CDDDR arraycall)))
      ((ZLC:LEXPR-FUNCALL funcall* apply)
       `(APPLY 'ZLC:ASET ,value ,(CADR arraycall) . ,(CDDR arraycall)))
      (t `(ZLC:ASET ,value (FUNCTION ,(CAR arraycall)) . ,(CDR arraycall))))))

(Defmacro get-locative-pointer-into-array (array-reference)
  (LET* ((ARRAYCALL (MACROEXPAND array-reference)))
    (CASE (CAR arraycall)
      (FUNCALL `(ALOC ,(CADR arraycall) . ,(CDDR arraycall)))
      (ARRAYCALL `(ALOC ,(CADDR arraycall) . ,(CDDDR arraycall)))
      ((ZLC:LEXPR-FUNCALL funcall* apply)
       `(APPLY 'ALOC ,(CADR arraycall) . ,(CDDR arraycall)))
      (t `(ALOC (FUNCTION ,(CAR arraycall)) . ,(CDR arraycall))))))

(Defsubst ticl:ar-1 (ARRAY index)
  "Access an element of ARRAY, an array of rank 1, according to index."
  (common-lisp-ar-1 array index))

(Defsubst ticl:ar-1-force (ARRAY index)
  "Access an element of ARRAY, indexing it by INDEX as if it were one dimensional."
  (common-lisp-ar-1-force array index))

(Defsubst svref (VECTOR index)
  "Accesses an element of a simple vector.  Actually the same as cli:aref."
  (cli:aref vector index))

(Defsubst bit (bitarray &rest subscripts)
  "Accesses an element of a bit array.  Actually the same as cli:aref."
  (APPLY 'cli:aref bitarray subscripts))

(Defsubst sbit (bitarray &rest subscripts)
  "Accesses an element of a simple bit array.  Actually the same as cli:aref."
  (APPLY 'cli:aref bitarray subscripts))