From cb9438c0acf9866b2788cd24bc55b3f712c192a5 Mon Sep 17 00:00:00 2001
From: Bart Botta <00003b@gmail.com>
Date: Wed, 26 Nov 2008 20:19:04 -0600
Subject: [PATCH] add stuff for array access

multiname-l support, :%array-read asm-macro
---
 asm/asm.lisp     | 10 +++++++++-
 asm/context.lisp | 28 +++++++++++++++++++++++++++-
 2 files changed, 36 insertions(+), 2 deletions(-)

diff --git a/asm/asm.lisp b/asm/asm.lisp
index bf089d7..d0e39de 100644
--- a/asm/asm.lisp
+++ b/asm/asm.lisp
@@ -297,6 +297,7 @@
 (defun asm-intern-multiname (mn)
   (typecase mn
     ((cons (eql :qname)) (apply 'qname (cdr mn)))
+    ((cons (eql :multiname-l)) (apply 'intern-multiname-l +multiname-l+ (cdr mn)))
     ;; todo: add other types of multinames
     ((cons (eql :id)) (second mn))
     (symbol (apply 'qname (cdr (symbol-to-qname-list mn)))) ;; not sure if this is good or not, needed for calling as-yet undefined functions though...
@@ -307,6 +308,8 @@
 ;; (asm-intern-multiname '(:qname "foo" "bax"))
 ;; (asm-intern-multiname '(:qname "foo" "bax"))
 ;; x(asm-intern-multiname 'cos) ;; not sure if we should support symbols or not
+;;(intern-multiname +multiname-l+ "" "") (elt (multinames *assembler-context*) 1)
+
 
 (defparameter *multiname-kinds* (make-hash-table))
 (setf (gethash +qname+ *multiname-kinds*) :qname)
@@ -499,4 +502,9 @@
 
 (defmacro with-assembler-context (&body body)
   `(let ((*assembler-context* (make-instance 'assembler-context)))
-     ,@body))
\ No newline at end of file
+     ,@body))
+
+;;; not sure if this should be asm level or not...
+(define-asm-macro :%array-read (index)
+  (assemble `((:push-int ,index)
+              (:get-property (:multiname-l "" "")))))
diff --git a/asm/context.lisp b/asm/context.lisp
index 40a37c0..7d914da 100644
--- a/asm/context.lisp
+++ b/asm/context.lisp
@@ -31,7 +31,8 @@
 
    ;; probably should eventually do this for all constants
    (string-intern-hash :initform (make-hash-table :test 'equal) :reader string-intern-hash)
-   (multiname-hash :initform (make-hash-table :test 'equalp) :reader multiname-hash)))
+   (multiname-hash :initform (make-hash-table :test 'equalp) :reader multiname-hash)
+   (ns-set-hash :initform (make-hash-table :test 'equalp) :reader ns-set-hash)))
 
 
 (defparameter *assembler-context* (make-instance 'assembler-context))
@@ -106,6 +107,20 @@
           (vector-push-extend (list kind (string-id sym))
                               (namespaces *assembler-context*))))))
 
+(defun avm2-ns-set-intern (namespaces)
+  (let* ((ns-ids (loop for i in namespaces
+                     when (numberp i)
+                     collect i
+                     else
+                     collect (avm2-ns-intern i)))
+         (id (gethash ns-ids (ns-set-hash *assembler-context*))))
+    (if id
+        id
+        (prog1
+          (setf (gethash ns-ids (ns-set-hash *assembler-context*))
+                (length (ns-sets *assembler-context*)))
+          (vector-push-extend ns-ids (ns-sets *assembler-context*))))))
+
 
 ;;; multiname.kind values
 (defparameter +qname+        #x07)
@@ -131,6 +146,17 @@
           (setf (gethash mn (multiname-hash *assembler-context*))
                 (1- (length (multinames *assembler-context*))))))))
 
+(defun intern-multiname-l (kind &rest ns-list)
+  (let* ((ns-set (avm2-ns-set-intern ns-list))
+         (mn (list kind ns-set))
+         (id (gethash mn (multiname-hash *assembler-context*))))
+    (if id
+        id
+        (progn
+          (vector-push-extend mn (multinames *assembler-context*))
+          (setf (gethash mn (multiname-hash *assembler-context*))
+                (1- (length (multinames *assembler-context*))))))))
+
 (defun qname (ns name)
   (intern-multiname +qname+ ns name))
 
-- 
2.11.4.GIT