diff options
author | Andy Wingo <wingo@pobox.com> | 2018-03-30 22:11:18 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2018-03-30 22:11:18 +0200 |
commit | 1f6f282f163598baacc89ec4d38342ff17c7092a (patch) | |
tree | 8aa29e0bae2a8bf95a93e8feb5dd6b8502acde93 /module | |
parent | 4d530a94bbe9be2d54216d07b002e700368d4b28 (diff) | |
download | guile-1f6f282f163598baacc89ec4d38342ff17c7092a.tar.gz |
Compile some generic arithmetic to intrinsic calls
* libguile/intrinsics.h: Rename intrinsic types added in previous
commit.
* libguile/vm-engine.c (call-scm<-scm-scm, call-scm<-scm-uimm): New
instructions.
* libguile/vm.c: Include intrinsics.h.
* module/language/bytecode.scm
* module/language/bytecode.scm (*intrinsic-codes*, *intrinsic-names*):
New internal definitions.
(intrinsic-name->index, intrinsic-index->name): New exported
definitions.
* module/system/vm/assembler.scm (encode-X8_S8_S8_S8-C32<-/shuffle):
(encode-X8_S8_S8_C8-C32<-/shuffle): New shuffling encoders.
(shuffling-encoder-name): Add case for new shuffling encoders.
(define-scm<-scm-scm-intrinsic, define-scm<-scm-uimm-intrinsic): New
helpers. Define encoders for "add", etc.
Diffstat (limited to 'module')
-rw-r--r-- | module/language/bytecode.scm | 27 | ||||
-rw-r--r-- | module/system/vm/assembler.scm | 66 |
2 files changed, 79 insertions, 14 deletions
diff --git a/module/language/bytecode.scm b/module/language/bytecode.scm index b6be04178..e072a09bd 100644 --- a/module/language/bytecode.scm +++ b/module/language/bytecode.scm @@ -1,6 +1,6 @@ ;;; Bytecode -;; Copyright (C) 2013, 2017 Free Software Foundation, Inc. +;; Copyright (C) 2013, 2017, 2018 Free Software Foundation, Inc. ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -24,12 +24,16 @@ #:export (instruction-list instruction-arity builtin-name->index - builtin-index->name)) + builtin-index->name + intrinsic-name->index + intrinsic-index->name)) (load-extension (string-append "libguile-" (effective-version)) "scm_init_instructions") (load-extension (string-append "libguile-" (effective-version)) "scm_init_vm_builtins") +(load-extension (string-append "libguile-" (effective-version)) + "scm_init_intrinsics") (define (compute-instruction-arity name args) (define (first-word-arity word) @@ -104,3 +108,22 @@ (define (instruction-arity name) (hashq-ref (force *instruction-arities*) name)) + +(define *intrinsic-codes* + (delay (let ((tab (make-hash-table))) + (for-each (lambda (pair) + (hashv-set! tab (car pair) (cdr pair))) + (intrinsic-list)) + tab))) + +(define *intrinsic-names* + (delay (let ((tab (make-hash-table))) + (hash-for-each (lambda (k v) (hashq-set! tab v k)) + (force *intrinsic-codes*)) + tab))) + +(define (intrinsic-name->index name) + (hashq-ref (force *intrinsic-codes*) name)) + +(define (intrinsic-index->name index) + (hashv-ref (force *intrinsic-names*) index)) diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index 4ac435356..14a0a34d7 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -179,6 +179,20 @@ emit-f32-set! emit-f64-set! + ;; Intrinsics. + emit-add + emit-add/immediate + emit-sub + emit-sub/immediate + emit-mul + emit-div + emit-quo + emit-rem + emit-mod + emit-logand + emit-logior + emit-logxor + emit-call emit-call-label emit-tail-call @@ -219,15 +233,6 @@ emit-string->number emit-string->symbol emit-symbol->keyword - emit-add - emit-add/immediate - emit-sub - emit-sub/immediate - emit-mul - emit-div - emit-quo - emit-rem - emit-mod emit-lsh emit-rsh emit-lsh/immediate @@ -242,9 +247,6 @@ emit-uadd/immediate emit-usub/immediate emit-umul/immediate - emit-logand - emit-logior - emit-logxor emit-logsub emit-ulogand emit-ulogior @@ -871,6 +873,24 @@ later by the linker." (emit-push asm a) (encode-X8_S8_C8_S8 asm 0 const 0 opcode) (emit-pop asm dst)))) +(define (encode-X8_S8_S8_S8-C32<-/shuffle asm dst a b c32 opcode) + (cond + ((< (logior dst a b) (ash 1 8)) + (encode-X8_S8_S8_S8-C32 asm dst a b c32 opcode)) + (else + (emit-push asm a) + (emit-push asm (1+ b)) + (encode-X8_S8_S8_S8-C32 asm 1 1 0 c32 opcode) + (emit-drop asm 1) + (emit-pop asm dst)))) +(define (encode-X8_S8_S8_C8-C32<-/shuffle asm dst a const c32 opcode) + (cond + ((< (logior dst a) (ash 1 8)) + (encode-X8_S8_S8_C8-C32 asm dst a const c32 opcode)) + (else + (emit-push asm a) + (encode-X8_S8_S8_C8-C32 asm 0 0 const c32 opcode) + (emit-pop asm dst)))) (eval-when (expand) (define (id-append ctx a b) @@ -889,6 +909,8 @@ later by the linker." (('! 'X8_S8_S8_S8) #'encode-X8_S8_S8_S8!/shuffle) (('<- 'X8_S8_S8_S8) #'encode-X8_S8_S8_S8<-/shuffle) (('<- 'X8_S8_S8_C8) #'encode-X8_S8_S8_C8<-/shuffle) + (('<- 'X8_S8_S8_S8 'C32) #'encode-X8_S8_S8_S8-C32<-/shuffle) + (('<- 'X8_S8_S8_C8 'C32) #'encode-X8_S8_S8_C8-C32<-/shuffle) (('! 'X8_S8_C8_S8) #'encode-X8_S8_C8_S8!/shuffle) (('<- 'X8_S8_C8_S8) #'encode-X8_S8_C8_S8<-/shuffle) (else (encoder-name operands)))) @@ -1241,6 +1263,26 @@ returned instead." (visit-heap-tags define-heap-tag=?-macro-assembler) +(define-syntax-rule (define-scm<-scm-scm-intrinsic name) + (define-macro-assembler (name asm dst a b) + (emit-call-scm<-scm-scm asm dst a b (intrinsic-name->index 'name)))) +(define-syntax-rule (define-scm<-scm-uimm-intrinsic name) + (define-macro-assembler (name asm dst a b) + (emit-call-scm<-scm-uimm asm dst a b (intrinsic-name->index 'name)))) + +(define-scm<-scm-scm-intrinsic add) +(define-scm<-scm-uimm-intrinsic add/immediate) +(define-scm<-scm-scm-intrinsic sub) +(define-scm<-scm-uimm-intrinsic sub/immediate) +(define-scm<-scm-scm-intrinsic mul) +(define-scm<-scm-scm-intrinsic div) +(define-scm<-scm-scm-intrinsic quo) +(define-scm<-scm-scm-intrinsic rem) +(define-scm<-scm-scm-intrinsic mod) +(define-scm<-scm-scm-intrinsic logand) +(define-scm<-scm-scm-intrinsic logior) +(define-scm<-scm-scm-intrinsic logxor) + (define-macro-assembler (begin-program asm label properties) (emit-label asm label) (let ((meta (make-meta label properties (asm-start asm)))) |