diff options
Diffstat (limited to 'module/language/glil/compile-assembly.scm')
| -rw-r--r-- | module/language/glil/compile-assembly.scm | 35 |
1 files changed, 30 insertions, 5 deletions
diff --git a/module/language/glil/compile-assembly.scm b/module/language/glil/compile-assembly.scm index 4c92e0f5a..dcdbc5133 100644 --- a/module/language/glil/compile-assembly.scm +++ b/module/language/glil/compile-assembly.scm @@ -28,6 +28,7 @@ #:use-module ((system vm program) #:select (make-binding)) #:use-module (ice-9 receive) #:use-module ((srfi srfi-1) #:select (fold)) + #:use-module (rnrs bytevector) #:export (compile-assembly)) ;; Variable cache cells go in the object table, and serialize as their @@ -186,7 +187,11 @@ (receive (i object-alist) (object-index-and-alist (make-subprogram table prog) object-alist) - (emit-code/object `((object-ref ,i) ,@closure) + (emit-code/object `(,(if (< i 256) + `(object-ref ,i) + `(long-object-ref ,(quotient i 256) + ,(modulo i 256))) + ,@closure) object-alist))) (else ;; otherwise emit a load directly @@ -234,7 +239,10 @@ (else (receive (i object-alist) (object-index-and-alist obj object-alist) - (emit-code/object `((object-ref ,i)) + (emit-code/object (if (< i 256) + `((object-ref ,i)) + `((long-object-ref ,(quotient i 256) + ,(modulo i 256)))) object-alist))))) ((<glil-local> op index) @@ -264,9 +272,16 @@ (receive (i object-alist) (object-index-and-alist (make-variable-cache-cell name) object-alist) - (emit-code/object (case op - ((ref) `((toplevel-ref ,i))) - ((set) `((toplevel-set ,i)))) + (emit-code/object (if (< i 256) + `((,(case op + ((ref) 'toplevel-ref) + ((set) 'toplevel-set)) + ,i)) + `((,(case op + ((ref) 'long-toplevel-ref) + ((set) 'long-toplevel-set)) + ,(quotient i 256) + ,(modulo i 256)))) object-alist))))) ((define) (emit-code `((define ,(symbol->string name)) @@ -379,6 +394,16 @@ (let ((code (dump-object (vector-ref x i) addr))) (dump-objects (1+ i) (cons code codes) (addr+ addr code))))))) + ((and (array? x) (symbol? (array-type x))) + (let* ((type (dump-object (array-type x) addr)) + (shape (dump-object (array-shape x) (addr+ addr type)))) + `(,@type + ,@shape + ,@(align-code + `(load-array ,(uniform-array->bytevector x)) + (addr+ (addr+ addr type) shape) + 8 + 4)))) (else (error "assemble: unrecognized object" x)))) |