[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 03/07: Add (system base types internal).
From: |
Andy Wingo |
Subject: |
[Guile-commits] 03/07: Add (system base types internal). |
Date: |
Thu, 26 Oct 2017 10:07:17 -0400 (EDT) |
wingo pushed a commit to branch master
in repository guile.
commit 38c6f6fabf7161de052d0784d5e347f984cff04a
Author: Andy Wingo <address@hidden>
Date: Wed Oct 25 12:24:49 2017 +0200
Add (system base types internal).
* module/system/base/types/internal.scm: New file, extracted
from (system base types).
* module/system/base/types.scm: Use (system base types internal) and
adapt to %tc1-pair, %tc2-inum, and %tc3-heap-object name changes.
* module/Makefile.am (SOURCES):
* am/bootstrap.am (SOURCES): Add new file.
---
am/bootstrap.am | 3 +-
module/Makefile.am | 3 +-
module/system/base/types.scm | 54 +------------
module/system/base/types/internal.scm | 140 ++++++++++++++++++++++++++++++++++
4 files changed, 148 insertions(+), 52 deletions(-)
diff --git a/am/bootstrap.am b/am/bootstrap.am
index e0d4764..d848745 100644
--- a/am/bootstrap.am
+++ b/am/bootstrap.am
@@ -1,5 +1,5 @@
## Copyright (C) 2009, 2010, 2011, 2012, 2013,
-## 2014, 2015 Free Software Foundation, Inc.
+## 2014, 2015, 2017 Free Software Foundation, Inc.
##
## This file is part of GNU Guile.
##
@@ -121,6 +121,7 @@ SOURCES = \
system/base/message.scm \
system/base/target.scm \
system/base/types.scm \
+ system/base/types/internal.scm \
system/base/ck.scm \
\
ice-9/boot-9.scm \
diff --git a/module/Makefile.am b/module/Makefile.am
index 8a8eab5..ef8e7c1 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -1,7 +1,7 @@
## Process this file with automake to produce Makefile.in.
##
## Copyright (C) 2009, 2010, 2011, 2012, 2013,
-## 2014, 2015 Free Software Foundation, Inc.
+## 2014, 2015, 2017 Free Software Foundation, Inc.
##
## This file is part of GUILE.
##
@@ -304,6 +304,7 @@ SOURCES = \
system/base/message.scm \
system/base/target.scm \
system/base/types.scm \
+ system/base/types/internal.scm \
system/base/ck.scm \
\
system/foreign.scm \
diff --git a/module/system/base/types.scm b/module/system/base/types.scm
index daf8bdf..e8f51ba 100644
--- a/module/system/base/types.scm
+++ b/module/system/base/types.scm
@@ -29,6 +29,7 @@
#:use-module (ice-9 format)
#:use-module (ice-9 vlist)
#:use-module (system foreign)
+ #:use-module (system base types internal)
#:export (%word-size
memory-backend
@@ -225,53 +226,6 @@ the matching bits, possibly with bitwise operations to
extract it from BITS."
(match-scm-clauses bits* clauses ...)))))
-;;;
-;;; Tags---keep in sync with libguile/tags.h!
-;;;
-
-;; Immediate values.
-(define %tc2-int 2)
-(define %tc3-imm24 4)
-
-(define %tc3-cons 0)
-(define %tc3-int1 %tc2-int)
-(define %tc3-int2 (+ %tc2-int 4))
-
-(define %tc8-char (+ 8 %tc3-imm24))
-(define %tc8-flag (+ %tc3-imm24 0))
-
-;; Cell types.
-(define %tc3-struct #x01)
-(define %tc7-symbol #x05)
-(define %tc7-variable #x07)
-(define %tc7-vector #x0d)
-(define %tc7-wvect #x0f)
-(define %tc7-string #x15)
-(define %tc7-number #x17)
-(define %tc7-hashtable #x1d)
-(define %tc7-pointer #x1f)
-(define %tc7-fluid #x25)
-(define %tc7-stringbuf #x27)
-(define %tc7-dynamic-state #x2d)
-(define %tc7-frame #x2f)
-(define %tc7-keyword #x35)
-(define %tc7-syntax #x3d)
-(define %tc7-program #x45)
-(define %tc7-vm-continuation #x47)
-(define %tc7-bytevector #x4d)
-(define %tc7-weak-set #x55)
-(define %tc7-weak-table #x57)
-(define %tc7-array #x5d)
-(define %tc7-bitvector #x5f)
-(define %tc7-port #x7d)
-(define %tc7-smob #x77)
-
-(define %tc16-bignum (+ %tc7-number (* 1 256)))
-(define %tc16-real (+ %tc7-number (* 2 256)))
-(define %tc16-complex (+ %tc7-number (* 3 256)))
-(define %tc16-fraction (+ %tc7-number (* 4 256)))
-
-
;; "Stringbufs".
(define-record-type <stringbuf>
(stringbuf string)
@@ -489,11 +443,11 @@ using BACKEND."
"Return the Scheme object corresponding to BITS, the bits of an 'SCM'
object."
(match-scm bits
- (((integer << 2) || %tc2-int)
+ (((integer << 2) || %tc2-inum)
integer)
- ((address & 6 = %tc3-cons)
+ ((address & 7 = %tc3-heap-object)
(let* ((type (dereference-word backend address))
- (pair? (not (bit-set? 0 type))))
+ (pair? (= (logand type #b1) %tc1-pair)))
(if pair?
(or (and=> (vhash-assv address (%visited-cells)) cdr)
(let ((car type)
diff --git a/module/system/base/types/internal.scm
b/module/system/base/types/internal.scm
new file mode 100644
index 0000000..41d55ef
--- /dev/null
+++ b/module/system/base/types/internal.scm
@@ -0,0 +1,140 @@
+;;; Details on internal value representation.
+;;; Copyright (C) 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 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 program. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (system base types internal)
+ #:export (;; Immediate tags.
+ %tc2-inum
+ %tc3-imm24
+ %tc3-heap-object
+ %tc8-char
+ %tc8-flag
+ %tc16-false
+ %tc16-nil
+ %tc16-eol
+ %tc16-true
+ %tc16-unspecified
+ %tc16-undefined
+ %tc16-eof
+
+ ;; Heap object tags (cell types).
+ %tc1-pair
+ %tc3-struct
+ %tc7-symbol
+ %tc7-variable
+ %tc7-vector
+ %tc7-wvect
+ %tc7-string
+ %tc7-number
+ %tc7-hashtable
+ %tc7-pointer
+ %tc7-fluid
+ %tc7-stringbuf
+ %tc7-dynamic-state
+ %tc7-frame
+ %tc7-keyword
+ %tc7-syntax
+ %tc7-program
+ %tc7-vm-continuation
+ %tc7-bytevector
+ %tc7-weak-set
+ %tc7-weak-table
+ %tc7-array
+ %tc7-bitvector
+ %tc7-port
+ %tc7-smob
+ %tc16-bignum
+ %tc16-real
+ %tc16-complex
+ %tc16-fraction))
+
+;;; Commentary:
+;;;
+;;; Tag values used to represent Scheme values, internally to Guile.
+;;;
+;;; Code:
+
+
+;;;
+;;; Tags---keep in sync with libguile/tags.h!
+;;;
+
+;; Immediate tags.
+(eval-when (expand load eval)
+ (define %tc2-inum #b10)
+ (define %tc3-imm24 #b100)
+ (define %tc3-heap-object #b000)
+
+ (define %tc8-flag (+ %tc3-imm24 0))
+ (define %tc8-char (+ %tc3-imm24 8))
+
+ (define %tc16-false (+ (ash #b0000 8) %tc8-flag))
+ (define %tc16-nil (+ (ash #b0001 8) %tc8-flag))
+ (define %tc16-eol (+ (ash #b0011 8) %tc8-flag))
+ (define %tc16-true (+ (ash #b0100 8) %tc8-flag))
+ (define %tc16-unspecified (+ (ash #b1000 8) %tc8-flag))
+ (define %tc16-undefined (+ (ash #b1001 8) %tc8-flag))
+ (define %tc16-eof (+ (ash #b1010 8) %tc8-flag)))
+
+;; See discussion in tags.h and boolean.h.
+(eval-when (expand)
+ (let ()
+ (define (exactly-one-bit-set? x)
+ (and (not (zero? x)) (zero? (logand x (1- x)))))
+ (define (exactly-two-bits-set? x)
+ (exactly-one-bit-set? (logand x (1- x))))
+ (define (bits-differ-in-exactly-one-bit-position? a b)
+ (exactly-one-bit-set? (logxor a b)))
+ (define (bits-differ-in-exactly-two-bit-positions? a b)
+ (exactly-two-bits-set? (logxor a b)))
+
+ (unless (bits-differ-in-exactly-one-bit-position? %tc16-eol %tc16-nil)
+ (error "expected #nil and '() to differ in exactly one bit position"))
+ (unless (bits-differ-in-exactly-one-bit-position? %tc16-false %tc16-nil)
+ (error "expected #f and '() to differ in exactly one bit position"))
+ (unless (bits-differ-in-exactly-two-bit-positions? %tc16-false %tc16-eol)
+ (error "expected #f and '() to differ in exactly two bit positions"))))
+
+;; Heap object tags (cell types).
+(define %tc1-pair #b0)
+(define %tc3-struct #x01)
+(define %tc7-symbol #x05)
+(define %tc7-variable #x07)
+(define %tc7-vector #x0d)
+(define %tc7-wvect #x0f)
+(define %tc7-string #x15)
+(define %tc7-number #x17)
+(define %tc7-hashtable #x1d)
+(define %tc7-pointer #x1f)
+(define %tc7-fluid #x25)
+(define %tc7-stringbuf #x27)
+(define %tc7-dynamic-state #x2d)
+(define %tc7-frame #x2f)
+(define %tc7-keyword #x35)
+(define %tc7-syntax #x3d)
+(define %tc7-program #x45)
+(define %tc7-vm-continuation #x47)
+(define %tc7-bytevector #x4d)
+(define %tc7-weak-set #x55)
+(define %tc7-weak-table #x57)
+(define %tc7-array #x5d)
+(define %tc7-bitvector #x5f)
+(define %tc7-port #x7d)
+(define %tc7-smob #x77)
+
+(define %tc16-bignum (+ %tc7-number (* 1 256)))
+(define %tc16-real (+ %tc7-number (* 2 256)))
+(define %tc16-complex (+ %tc7-number (* 3 256)))
+(define %tc16-fraction (+ %tc7-number (* 4 256)))
- [Guile-commits] branch master updated (214e887 -> cd947a1), Andy Wingo, 2017/10/26
- [Guile-commits] 04/07: Add assembler and disassembler support for new instructions, Andy Wingo, 2017/10/26
- [Guile-commits] 03/07: Add (system base types internal).,
Andy Wingo <=
- [Guile-commits] 01/07: Add support for C16_C16 instruction words, Andy Wingo, 2017/10/26
- [Guile-commits] 02/07: Add new-style test and branch instructions, Andy Wingo, 2017/10/26
- [Guile-commits] 07/07: Model all special immediates under one type bit (with range), Andy Wingo, 2017/10/26
- [Guile-commits] 05/07: First step towards emitting new instructions: "j" instead of "br", Andy Wingo, 2017/10/26
- [Guile-commits] 06/07: Type inference distinguishes &fixnum and &bignum types, Andy Wingo, 2017/10/26