/usr/share/scsh-0.6/link/data.scm is in scsh-common-0.6 0.6.7-8.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 | ; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Scheme 48's data representations, for writing heap images.
; Defines things needed by TRANSPORT (which is called by WRITE-IMAGE, which
; is called by the static linker).
; Adapted from vm/util.scm and vm/data.scm.
(define (low-bits n k)
(bitwise-and n (- (arithmetic-shift 1 k) 1)))
(define (high-bits n k)
(arithmetic-shift n (- 0 k)))
(define (adjoin-bits high low width)
(bitwise-ior (arithmetic-shift high width) low))
; Essential constants
(define level 17)
(define little-endian? #t)
(define bits-per-byte 8)
(define bytes-per-cell 4)
(define bits-per-cell (* bits-per-byte bytes-per-cell))
(define addressing-units-per-cell 4)
; This is actually the mimimum for the different PreScheme implementations.
; The Scheme version of PreScheme leaves 30 bits for PreScheme's fixnums.
; There have to be enough bits to represent the largest fixnum in the system.
; USEFUL-BITS-PER-WORD is not written in the image.
(define useful-bits-per-word 30)
(define unused-field-width 2)
(define tag-field-width 2)
(define immediate-type-field-width
(- 8 tag-field-width))
; Data descriptions copied from DATA.SCM
(define-enumeration tag
(fixnum
immediate
header
stob))
(define-enumeration imm
(false ; #f
true ; #t
char
unspecific
undefined
eof
null))
(define bits-per-fixnum
(- (if (< bits-per-cell useful-bits-per-word)
bits-per-cell
useful-bits-per-word)
tag-field-width))
(define least-fixnum-value (- 0 (arithmetic-shift 1 (- bits-per-fixnum 1))))
(define greatest-fixnum-value (- (arithmetic-shift 1 (- bits-per-fixnum 1))
1))
(define (fixnum? x)
(and (integer? x)
(>= x least-fixnum-value)
(<= x greatest-fixnum-value)))
(define (immediate? x)
(or (fixnum? x)
(char? x)
(eq? x #t)
(eq? x '()) ; I think order is important here as () is a literal while
(eq? x #f) ; #F is generated with an instruction. If () = #f then
; we still lose on something like '(#F) (which is
; present in the system).
;; (eq? thing (unspecific))
))
(define car-offset 0)
(define cdr-offset 1)
(define closure-template-offset 0)
(define closure-env-offset 1)
(define location-contents-offset 1)
(define location-id-offset 0)
; Procedures for manipulating bits
(define (make-descriptor tag data)
(adjoin-bits data tag tag-field-width))
(define (make-immediate type info)
(make-descriptor (enum tag immediate)
(adjoin-bits info type immediate-type-field-width)))
(define vm-true (make-immediate (enum imm true) 0))
(define vm-false (make-immediate (enum imm false) 0))
(define vm-null (make-immediate (enum imm null) 0))
(define vm-unspecific (make-immediate (enum imm unspecific) 0))
(define vm-unbound (make-immediate (enum imm undefined) 1))
(define vm-unassigned (make-immediate (enum imm undefined) 2))
(define header-type-field-width (- immediate-type-field-width 1))
(define (make-header type length-in-bytes)
(make-descriptor (enum tag header) (adjoin-bits length-in-bytes
type
(+ 1 header-type-field-width))))
(define (make-header-immutable header)
(bitwise-ior header (arithmetic-shift 1 (+ tag-field-width
header-type-field-width))))
(define (make-stob-descriptor addr)
(make-descriptor (enum tag stob) (a-units->cells addr)))
(define (bytes->cells bytes)
(quotient (+ bytes (- bytes-per-cell 1))
bytes-per-cell))
(define (cells->bytes cells)
(* cells bytes-per-cell))
(define (cells->a-units cells)
(adjoin-bits cells 0 unused-field-width))
(define (a-units->cells cells)
(high-bits cells unused-field-width))
(define (bytes->a-units byte-count)
(cells->a-units (bytes->cells byte-count)))
|