diff options
Diffstat (limited to 'module/language/assembly.scm')
-rw-r--r-- | module/language/assembly.scm | 105 |
1 files changed, 70 insertions, 35 deletions
diff --git a/module/language/assembly.scm b/module/language/assembly.scm index 28dde1e1a..683da6cc1 100644 --- a/module/language/assembly.scm +++ b/module/language/assembly.scm @@ -2,57 +2,54 @@ ;; Copyright (C) 2001, 2009 Free Software Foundation, Inc. -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;;;; This library is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Lesser General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 3 of the License, or (at your option) any later version. +;;;; +;;;; This library is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;;; Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this library; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA ;;; Code: (define-module (language assembly) + #:use-module (rnrs bytevector) #:use-module (system base pmatch) #:use-module (system vm instruction) #:use-module ((srfi srfi-1) #:select (fold)) #:export (byte-length - addr+ align-program + addr+ align-program align-code align-block assembly-pack assembly-unpack object->assembly assembly->object)) -;; nargs, nrest, nlocs, nexts, len, metalen -(define *program-header-len* (+ 1 1 1 1 4 4)) +;; nargs, nrest, nlocs, len, metalen, padding +(define *program-header-len* (+ 1 1 2 4 4 4)) ;; lengths are encoded in 3 bytes (define *len-len* 3) + (define (byte-length assembly) (pmatch assembly (,label (guard (not (pair? label))) 0) - ((load-unsigned-integer ,str) - (+ 1 *len-len* (string-length str))) - ((load-integer ,str) - (+ 1 *len-len* (string-length str))) ((load-number ,str) (+ 1 *len-len* (string-length str))) ((load-string ,str) (+ 1 *len-len* (string-length str))) + ((load-wide-string ,str) + (+ 1 *len-len* (* 4 (string-length str)))) ((load-symbol ,str) (+ 1 *len-len* (string-length str))) - ((load-keyword ,str) - (+ 1 *len-len* (string-length str))) - ((define ,str) - (+ 1 *len-len* (string-length str))) - ((load-program ,nargs ,nrest ,nlocs ,nexts ,labels ,len ,meta . ,code) + ((load-array ,bv) + (+ 1 *len-len* (bytevector-length bv))) + ((load-program ,nargs ,nrest ,nlocs ,labels ,len ,meta . ,code) (+ 1 *program-header-len* len (if meta (1- (byte-length meta)) 0))) ((,inst . _) (guard (>= (instruction-length inst) 0)) (+ 1 (instruction-length inst))) @@ -61,18 +58,28 @@ (define *program-alignment* 8) +(define *block-alignment* 8) + (define (addr+ addr code) (fold (lambda (x len) (+ (byte-length x) len)) addr code)) +(define (code-alignment addr alignment header-len) + (make-list (modulo (- alignment + (modulo (+ addr header-len) alignment)) + alignment) + '(nop))) + +(define (align-block addr) + (code-alignment addr *block-alignment* 0)) + +(define (align-code code addr alignment header-len) + `(,@(code-alignment addr alignment header-len) + ,code)) + (define (align-program prog addr) - `(,@(make-list (modulo (- *program-alignment* - (modulo (1+ addr) *program-alignment*)) - ;; plus the one for the load-program inst itself - *program-alignment*) - '(nop)) - ,prog)) + (align-code prog addr *program-alignment* 1)) ;;; ;;; Code compress/decompression @@ -104,12 +111,26 @@ ((null? x) `(make-eol)) ((and (integer? x) (exact? x)) (cond ((and (<= -128 x) (< x 128)) - `(make-int8 ,(modulo x 256))) + (assembly-pack `(make-int8 ,(modulo x 256)))) ((and (<= -32768 x) (< x 32768)) (let ((n (if (< x 0) (+ x 65536) x))) `(make-int16 ,(quotient n 256) ,(modulo n 256)))) + ((and (<= 0 x #xffffffffffffffff)) + `(make-uint64 ,@(bytevector->u8-list + (let ((bv (make-bytevector 8))) + (bytevector-u64-set! bv 0 x (endianness big)) + bv)))) + ((and (<= 0 (+ x #x8000000000000000) #x7fffffffffffffff)) + `(make-int64 ,@(bytevector->u8-list + (let ((bv (make-bytevector 8))) + (bytevector-s64-set! bv 0 x (endianness big)) + bv)))) (else #f))) - ((char? x) `(make-char8 ,(char->integer x))) + ((char? x) + (cond ((<= (char->integer x) #xff) + `(make-char8 ,(char->integer x))) + (else + `(make-char32 ,(char->integer x))))) (else #f))) (define (assembly->object code) @@ -122,9 +143,23 @@ ((make-int16 ,n1 ,n2) (let ((n (+ (* n1 256) n2))) (if (< n 32768) n (- n 65536)))) + ((make-uint64 ,n1 ,n2 ,n3 ,n4 ,n5 ,n6 ,n7 ,n8) + (bytevector-u64-ref + (u8-list->bytevector (list n1 n2 n3 n4 n5 n6 n7 n8)) + 0 + (endianness big))) + ((make-int64 ,n1 ,n2 ,n3 ,n4 ,n5 ,n6 ,n7 ,n8) + (bytevector-s64-ref + (u8-list->bytevector (list n1 n2 n3 n4 n5 n6 n7 n8)) + 0 + (endianness big))) ((make-char8 ,n) (integer->char n)) + ((make-char32 ,n1 ,n2 ,n3 ,n4) + (integer->char (+ (* n1 #x1000000) + (* n2 #x10000) + (* n3 #x100) + n4))) ((load-string ,s) s) ((load-symbol ,s) (string->symbol s)) - ((load-keyword ,s) (symbol->keyword (string->symbol s))) (else #f))) |