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)