summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/instructions.c5
-rw-r--r--module/language/bytecode.scm3
-rw-r--r--module/system/vm/assembler.scm10
-rw-r--r--module/system/vm/disassembler.scm5
4 files changed, 18 insertions, 5 deletions
diff --git a/libguile/instructions.c b/libguile/instructions.c
index 29e60983b..a38035d25 100644
--- a/libguile/instructions.c
+++ b/libguile/instructions.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2017 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 License
@@ -65,7 +65,8 @@ SCM_SYMBOL (sym_bang, "!");
M(B1_X7_C24) \
M(B1_X7_S24) \
M(B1_X7_F24) \
- M(B1_X31)
+ M(B1_X31) \
+ M(C16_C16)
#define TYPE_WIDTH 6
diff --git a/module/language/bytecode.scm b/module/language/bytecode.scm
index c140b4bb3..e25e8c923 100644
--- a/module/language/bytecode.scm
+++ b/module/language/bytecode.scm
@@ -1,6 +1,6 @@
;;; Bytecode
-;; Copyright (C) 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2013, 2017 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
@@ -58,6 +58,7 @@
((L32) 1)
((LO32) 1)
((C8_C24) 2)
+ ((C16_C16) 2)
((B1_C7_L24) 3)
((B1_X7_S24) 2)
((B1_X7_F24) 2)
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 1eb253f65..89b740762 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -1,6 +1,6 @@
;;; Guile bytecode assembler
-;;; Copyright (C) 2001, 2009, 2010, 2012, 2013, 2014, 2015 Free Software Foundation, Inc.
+;;; Copyright (C) 2001, 2009, 2010, 2012, 2013, 2014, 2015, 2017 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
@@ -278,6 +278,11 @@
(y (check-srange y #xffffff)))
(logior x (ash y 8))))
+(define-inline (pack-u16-u16 x y)
+ (let ((x (check-urange x #xffff))
+ (y (check-urange y #xffff)))
+ (logior x (ash y 16))))
+
(define-inline (pack-u1-u7-u24 x y z)
(let ((x (check-urange x #x1))
(y (check-urange y #x7f))
@@ -621,6 +626,8 @@ later by the linker."
(emit asm 0))
((C8_C24 a b)
(emit asm (pack-u8-u24 a b)))
+ ((C16_C16 a b)
+ (emit asm (pack-u16-u16 a b)))
((B1_X7_L24 a label)
(record-label-reference asm label)
(emit asm (pack-u1-u7-u24 (if a 1 0) 0 0)))
@@ -852,6 +859,7 @@ later by the linker."
('L32 #'(label))
('LO32 #'(label offset))
('C8_C24 #'(a b))
+ ('C16_C16 #'(a b))
('B1_X7_L24 #'(a label))
('B1_C7_L24 #'(a b label))
('B1_X31 #'(a))
diff --git a/module/system/vm/disassembler.scm b/module/system/vm/disassembler.scm
index 4db4a033d..0ab8c6bf9 100644
--- a/module/system/vm/disassembler.scm
+++ b/module/system/vm/disassembler.scm
@@ -1,6 +1,6 @@
;;; Guile bytecode disassembler
-;;; Copyright (C) 2001, 2009, 2010, 2012, 2013, 2014, 2015 Free Software Foundation, Inc.
+;;; Copyright (C) 2001, 2009, 2010, 2012, 2013, 2014, 2015, 2017 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
@@ -115,6 +115,9 @@
((C8_C24)
#'((logand word #xff)
(ash word -8)))
+ ((C16_C16)
+ #'((logand word #xffff)
+ (ash word -16)))
((B1_C7_L24)
#'((not (zero? (logand word #x1)))
(logand (ash word -1) #x7f)