Commit | Line | Data |
---|---|---|
53e28ed9 AW |
1 | ;;; Guile Virtual Machine Object Code |
2 | ||
3 | ;; Copyright (C) 2001 Free Software Foundation, Inc. | |
4 | ||
53befeb7 NJ |
5 | ;;;; This library is free software; you can redistribute it and/or |
6 | ;;;; modify it under the terms of the GNU Lesser General Public | |
7 | ;;;; License as published by the Free Software Foundation; either | |
8 | ;;;; version 3 of the License, or (at your option) any later version. | |
9 | ;;;; | |
10 | ;;;; This library is distributed in the hope that it will be useful, | |
11 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
13 | ;;;; Lesser General Public License for more details. | |
14 | ;;;; | |
15 | ;;;; You should have received a copy of the GNU Lesser General Public | |
16 | ;;;; License along with this library; if not, write to the Free Software | |
17 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA | |
53e28ed9 AW |
18 | |
19 | ;;; Code: | |
20 | ||
21 | (define-module (language objcode) | |
22 | #:export (encode-length decode-length)) | |
23 | ||
24 | \f | |
25 | ;;; | |
26 | ;;; Variable-length interface | |
27 | ;;; | |
28 | ||
29 | ;; NOTE: decoded in vm_fetch_length in vm.c as well. | |
30 | ||
31 | (define (encode-length len) | |
32 | (cond ((< len 254) (u8vector len)) | |
33 | ((< len (* 256 256)) | |
34 | (u8vector 254 (quotient len 256) (modulo len 256))) | |
35 | ((< len most-positive-fixnum) | |
36 | (u8vector 255 | |
37 | (quotient len (* 256 256 256)) | |
38 | (modulo (quotient len (* 256 256)) 256) | |
39 | (modulo (quotient len 256) 256) | |
40 | (modulo len 256))) | |
41 | (else (error "Too long code length:" len)))) | |
42 | ||
43 | (define (decode-length pop) | |
44 | (let ((x (pop))) | |
45 | (cond ((< x 254) x) | |
46 | ((= x 254) (+ (ash x 8) (pop))) | |
47 | (else | |
48 | (let* ((b2 (pop)) | |
49 | (b3 (pop)) | |
50 | (b4 (pop))) | |
51 | (+ (ash x 24) (ash b2 16) (ash b3 8) b4)))))) |