;;; -*- Mode:LISP; Package:LISP-INTERNALS; Base:10; Readtable:ZL -*-

;;;; Structures

(defafun STRUCTURE-REF (name index struct)

  (movei o0 '*debug-structure-ref* ch-open)
  (call (symbol:%symbol-value 1) r0 ())
  (alu xor nop r0 r0)
  (test br-equal)
  (branch no-break ())
  
  (movei o0 '"STRUCTURE-REF: " ch-open)
  (move  o1 a0)
  (move  o2 a1)
  (move  o3 a2)
  (call  (break 4) ignore ())

no-break
  
  ;; Read header and check data type of struct
  (alu setl (vma-start-read boxed-vma boxed-md) a2 gr:*random-array* dt-right-array-and-left-structure)
  ;; Check data type of index
  (alu setr a1 a1 a1 dt-both-fixnum boxed-right)
  ;; Check bounds of index
  (alu l-r nop a1 md bw-24)
  ;; Read structure name
  (alu l+r (vma-start-read unboxed-vma boxed-md) a2 gr:*one* br-not-less-than)
  (branch too-short ())
  (move a3 md)
  ;; start read of slot
  (alu l+r+c (vma-start-read unboxed-vma boxed-md) a1 a2 carry-1 bw-24)
  ;; test type
  (alu l-r nop a0 a3 bw-32)
  (test br-not-equal)
  (branch wrong-type ())
  ;; type ok, return slot
  (return md boxed-right)
 wrong-type
  (move o0 a0 ch-tail-open)
  (move o1 a1)
  (move o2 a2)
  (tail-call (structure-ref-wrong-type 4) (o3 a3))
 too-short
  (movei o0 '"The structure ~a does not have a slot ~a" boxed ch-tail-open)
  (move  o1 a2)
  (tail-call (error 3) (o2 a1)))