mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-18 18:40:22 +02:00
Code Activity

Fixed the compiler, got the disassembler working.

Browse source 
* doc/guile-vm.texi:  Texified and cleaned up.
* src/vm.c:  Use `scm_from_locale_string ()' instead of `scm_makfrom0str ()'.
* src/vm_engine.c:  Likewise.
* src/programs.c (scm_program_bytecode):  Return a u8vector instead of a string.
* module/system/vm/conv.scm (make-byte-decoder):  Fixed a few things wrt. to
  the string to u8vector transition.
* src/objcodes.c (bytecode->objcode):  Fixed a bug where the last 10 bytes of
  the bytecode where ignored.
* module/system/vm/assemble.scm (dump-object!):  Don't convert everything
  to a u8vector, keep strings where it makes sense.
* module/system/vm/conv.scm (code->bytes):  Accordingly, convert strings to
  u8vectors when needed.
  (make-byte-decoder):  Accordingly too, when decoding instructions, return
  variable-length instructions' argument as strings except for `load-program'.
* module/system/vm/disasm.scm:  Export `disassemble-bytecode'.

git-archimport-id: lcourtes@laas.fr--2004-libre/guile-vm--revival--0.6--patch-4
This commit is contained in:
Ludovic Court`es 2005-04-27 09:36:52 +00:00 • committed by Ludovic Courtès
parent 054599f117
commit fa19602c28
9 changed files with 223 additions and 135 deletions
Download patch file Download diff file Expand all files Collapse all files

248
doc/guile-vm.texi
View file

@ -6,9 +6,9 @@
@setchapternewpage odd @setchapternewpage odd
@c %**end of header @c %**end of header
@set EDITION 0.3 @set EDITION 0.6
@set VERSION 0.3 @set VERSION 0.6
@set UPDATED 2000-08-22 @set UPDATED 2005-04-26
@ifinfo @ifinfo
@dircategory Scheme Programming @dircategory Scheme Programming
@ -79,10 +79,14 @@ approved by the Free Software Foundation.
This document corresponds to Guile VM @value{VERSION}. This document corresponds to Guile VM @value{VERSION}.
@menu @menu
* Introduction::
* Variable Management::
* Program Execution::
* Instruction Set::
@end menu @end menu
@c ********************************************************************* @c *********************************************************************
@node Introduction, Getting Started, Top, Top @node Introduction, Variable Management, Top, Top
@chapter What is Guile VM? @chapter What is Guile VM?
A Guile VM has a set of registers and its own stack memory. Guile may A Guile VM has a set of registers and its own stack memory. Guile may
@ -90,33 +94,35 @@ have more than one VM's. Each VM may execute at most one program at a
time. Guile VM is a CISC system so designed as to execute Scheme and time. Guile VM is a CISC system so designed as to execute Scheme and
other languages efficiently. other languages efficiently.
@unnumberdsubsec Registers @unnumberedsubsec Registers
pc - Program counter ;; ip (instruction poiner) is better? @itemize
sp - Stack pointer @item pc - Program counter ;; ip (instruction poiner) is better?
bp - Base pointer @item sp - Stack pointer
ac - Accumulator @item bp - Base pointer
@item ac - Accumulator
@end itemize
@unnumberdsubsec Engine @unnumberedsubsec Engine
A VM may have one of three engines: reckless, regular, or debugging. A VM may have one of three engines: reckless, regular, or debugging.
Reckless engine is fastest but dangerous. Regular engine is normally Reckless engine is fastest but dangerous. Regular engine is normally
fail-safe and reasonably fast. Debugging engine is safest and fail-safe and reasonably fast. Debugging engine is safest and
functional but very slow. functional but very slow.
@unnumberdsubsec Memory @unnumberedsubsec Memory
Stack is the only memory that each VM owns. The other memory is shared Stack is the only memory that each VM owns. The other memory is shared
memory that is shared among every VM and other part of Guile. memory that is shared among every VM and other part of Guile.
@unnumberdsubsec Program @unnumberedsubsec Program
A VM program consists of a bytecode that is executed and an environment A VM program consists of a bytecode that is executed and an environment
in which execution is done. Each program is allocated in the shared in which execution is done. Each program is allocated in the shared
memory and may be executed by any VM. A program may call other programs memory and may be executed by any VM. A program may call other programs
within a VM. within a VM.
@unnumberdsubsec Instruction @unnumberedsubsec Instruction
Guile VM has dozens of system instructions and (possibly) hundreds of Guile VM has dozens of system instructions and (possibly) hundreds of
functional instructions. Some Scheme procedures such as cons and car functional instructions. Some Scheme procedures such as cons and car
@ -129,18 +135,19 @@ Most instructions deal with the accumulator (ac). The VM stores all
results from functions in ac, instead of pushing them into the stack. results from functions in ac, instead of pushing them into the stack.
I'm not sure whether this is a good thing or not. I'm not sure whether this is a good thing or not.
@node Variable Management @node Variable Management, Program Execution, Introduction, Top
@chapter Variable Management @chapter Variable Management
A program may have access to local variables, external variables, and A program may have access to local variables, external variables, and
top-level variables. top-level variables.
** Local/external variables @section Local/external variables
A stack is logically divided into several blocks during execution. A A stack is logically divided into several blocks during execution. A
"block" is such a unit that maintains local variables and dynamic chain. "block" is such a unit that maintains local variables and dynamic chain.
A "frame" is an upper level unit that maintains subprogram calls. A "frame" is an upper level unit that maintains subprogram calls.
@example
Stack Stack
dynamic | | | | dynamic | | | |
chain +==========+ - = chain +==========+ - =
@ -159,9 +166,11 @@ A "frame" is an upper level unit that maintains subprogram calls.
/|frame data| | | /|frame data| | |
| +----------+ - | | +----------+ - |
| | | | | | | | | |
@end example
The first block of each frame may look like this: The first block of each frame may look like this:
@example
Address Data Address Data
------- ---- ------- ----
xxx0028 Local variable 2 xxx0028 Local variable 2
@ -172,6 +181,7 @@ The first block of each frame may look like this:
xxx0014 Stack pointer (block data) xxx0014 Stack pointer (block data)
xxx0010 Return address (frame data) xxx0010 Return address (frame data)
xxx000c Parent program (frame data) xxx000c Parent program (frame data)
@end example
The base pointer (bp) always points to the lowest address of local The base pointer (bp) always points to the lowest address of local
variables of the recent block. Local variables are referred as "bp[n]". variables of the recent block. Local variables are referred as "bp[n]".
@ -185,6 +195,7 @@ The external link field of a block has a pointer to such a variable set,
which I call "fragment" (what should I call?). A fragment has a set of which I call "fragment" (what should I call?). A fragment has a set of
variables and its own chain. variables and its own chain.
@example
local external local external
chain| | chain chain| | chain
| +-----+ .--------, | | +-----+ .--------, |
@ -195,6 +206,7 @@ variables and its own chain.
`-|block|---->|external|-' `-|block|---->|external|-'
+-----+ `--------' +-----+ `--------'
| | | |
@end example
An external variable is referred as "bp[-2]->variables[n]" or An external variable is referred as "bp[-2]->variables[n]" or
"bp[-2]->link->...->variables[n]". This is also represented by a pair "bp[-2]->link->...->variables[n]". This is also represented by a pair
@ -204,19 +216,21 @@ current environment of a program.
Other data fields are described later. Other data fields are described later.
** Top-level variables @section Top-level variables
Guile VM uses the same top-level variables as the regular Guile. A Guile VM uses the same top-level variables as the regular Guile. A
program may have direct access to vcells. Currently this is done by program may have direct access to vcells. Currently this is done by
calling scm_intern0, but a program is possible to have any top-level calling scm_intern0, but a program is possible to have any top-level
environment defined by the current module. environment defined by the current module.
*** Scheme and VM variable @section Scheme and VM variable
Let's think about the following Scheme code as an example: Let's think about the following Scheme code as an example:
@example
(define (foo a) (define (foo a)
(lambda (b) (list foo a b))) (lambda (b) (list foo a b)))
@end example
In the lambda expression, "foo" is a top-level variable, "a" is an In the lambda expression, "foo" is a top-level variable, "a" is an
external variable, and "b" is a local variable. external variable, and "b" is a local variable.
@ -228,24 +242,28 @@ creates a subprogram (closure), associating the fragment with the
subprogram as its external environment. When the closure is executed, subprogram as its external environment. When the closure is executed,
its environment will look like this: its environment will look like this:
@example
block Top-level: foo block Top-level: foo
+-------------+ +-------------+
|local var: b | fragment |local var: b | fragment
+-------------+ .-----------, +-------------+ .-----------,
|external link|---->|variable: a| |external link|---->|variable: a|
+-------------+ `-----------' +-------------+ `-----------'
@end example
The fragment remains as long as the closure exists. The fragment remains as long as the closure exists.
** Addressing mode @section Addressing mode
Guile VM has five addressing modes: Guile VM has five addressing modes:
o Real address @itemize
o Local position @item Real address
o External position @item Local position
o Top-level location @item External position
o Constant object @item Top-level location
@item Constant object
@end itemize
Real address points to the address in the real program and is only used Real address points to the address in the real program and is only used
with the program counter (pc). with the program counter (pc).
@ -262,50 +280,56 @@ object directly.
[ We'll also need dynamic scope addressing to support Emacs Lisp? ] [ We'll also need dynamic scope addressing to support Emacs Lisp? ]
*** At a Glance @unnumberedsubsec At a Glance
Guile VM has a set of instructions for each instruction family. `%load' Guile VM has a set of instructions for each instruction family. `%load'
is, for example, a family to load an object from memory and set the is, for example, a family to load an object from memory and set the
accumulator (ac). There are four basic `%load' instructions: accumulator (ac). There are four basic `%load' instructions:
@example
%loadl - Local addressing %loadl - Local addressing
%loade - External addressing %loade - External addressing
%loadt - Top-level addressing %loadt - Top-level addressing
%loadi - Immediate addressing %loadi - Immediate addressing
@end example
A possible program code may look like this: A possible program code may look like this:
@example
%loadl (0 . 1) ; ac = local[0][1] %loadl (0 . 1) ; ac = local[0][1]
%loade (2 . 3) ; ac = external[2][3] %loade (2 . 3) ; ac = external[2][3]
%loadt (foo . #<undefined>) ; ac = #<undefined> %loadt (foo . #<undefined>) ; ac = #<undefined>
%loadi "hello" ; ac = "hello" %loadi "hello" ; ac = "hello"
@end example
One instruction that uses real addressing is `%jump', which changes the One instruction that uses real addressing is `%jump', which changes the
value of the program counter: value of the program counter:
@example
%jump 0x80234ab8 ; pc = 0x80234ab8 %jump 0x80234ab8 ; pc = 0x80234ab8
@end example
* Program Execution
@node Program Execution, Instruction Set, Variable Management, Top
@chapter Program Execution
Overall procedure: Overall procedure:
1. A source program is compiled into a bytecode. @enumerate
@item A source program is compiled into a bytecode.
@item A bytecode is given an environment and becomes a program.
@item A VM starts execution, creating a frame for it.
@item Whenever a program calls a subprogram, a new frame is created for it.
@item When a program finishes execution, it returns a value, and the VM
continues execution of the parent program.
@item When all programs terminated, the VM returns the final value and stops.
@end enumerate
2. A bytecode is given an environment and becomes a program. @section Environment
3. A VM starts execution, creating a frame for it.
4. Whenever a program calls a subprogram, a new frame is created for it.
5. When a program finishes execution, it returns a value, and the VM
continues execution of the parent program.
6. When all programs terminated, the VM returns the final value and stops.
** Environment
Local variable: Local variable:
@example
(let ((a 1) (b 2) (c 3)) (+ a b c)) -> (let ((a 1) (b 2) (c 3)) (+ a b c)) ->
%pushi 1 ; a %pushi 1 ; a
@ -317,9 +341,11 @@ Local variable:
%pushl (0 . 2) ; local variable c %pushl (0 . 2) ; local variable c
add 3 ; ac = a + b + c add 3 ; ac = a + b + c
%unbind ; remove local bindings %unbind ; remove local bindings
@end example
External variable: External variable:
@example
(define foo (let ((n 0)) (lambda () n))) (define foo (let ((n 0)) (lambda () n)))
%pushi 0 ; n %pushi 0 ; n
@ -335,15 +361,19 @@ External variable:
%call 0 ; change the current external link %call 0 ; change the current external link
%loade (0 . 0) ; external variable n %loade (0 . 0) ; external variable n
%return ; recover the external link %return ; recover the external link
@end example
Top-level variable: Top-level variable:
@example
foo -> foo ->
%loadt (foo . #<program xxx>) ; top-level variable foo %loadt (foo . #<program xxx>) ; top-level variable foo
@end example
** Flow control @section Flow control
@example
(if #t 1 0) -> (if #t 1 0) ->
%loadi #t %loadi #t
@ -352,11 +382,13 @@ Top-level variable:
%jump L2 %jump L2
L1: %loadi 0 L1: %loadi 0
L2: L2:
@end example
** Function call @section Function call
Builtin function: Builtin function:
@example
(1+ 2) -> (1+ 2) ->
%loadi 2 ; ac = 2 %loadi 2 ; ac = 2
@ -374,9 +406,11 @@ Builtin function:
%pushi 2 ; 2 -> stack %pushi 2 ; 2 -> stack
%pushi 3 ; 3 -> stack %pushi 3 ; 3 -> stack
add 3 ; many argument add 3 ; many argument
@end example
External function: External function:
@example
(version) -> (version) ->
%func0 (version . #<primitive-procedure version>) ; no argument %func0 (version . #<primitive-procedure version>) ; no argument
@ -399,9 +433,11 @@ External function:
%pushi 3 %pushi 3
%loadi 3 ; the number of arguments %loadi 3 ; the number of arguments
%func (equal . #<primitive-procedure equal>) ; many arguments %func (equal . #<primitive-procedure equal>) ; many arguments
@end example
** Subprogram call @section Subprogram call
@example
(define (plus a b) (+ a b)) (define (plus a b) (+ a b))
(plus 1 2) -> (plus 1 2) ->
@ -413,8 +449,10 @@ External function:
%loadl (0 . 1) ; argument 2 %loadl (0 . 1) ; argument 2
add2 ; ac = 1 + 2 add2 ; ac = 1 + 2
%return ; result is 3 %return ; result is 3
@end example
* Instruction Set @node Instruction Set, , Program Execution, Top
@chapter Instruction Set
The Guile VM instruction set is roughly divided two groups: system The Guile VM instruction set is roughly divided two groups: system
instructions and functional instructions. System instructions control instructions and functional instructions. System instructions control
@ -422,79 +460,97 @@ the execution of programs, while functional instructions provide many
useful calculations. By convention, system instructions begin with a useful calculations. By convention, system instructions begin with a
letter `%'. letter `%'.
** Environment control instructions @section Environment control instructions
- %alloc @itemize
- %bind @item %alloc
- %export @item %bind
- %unbind @item %export
@item %unbind
@end itemize
** Subprogram control instructions @section Subprogram control instructions
- %make-program @itemize
- %call @item %make-program
- %return @item %call
@item %return
@end itemize
** Data control instructinos @section Data control instructinos
- %push @itemize
- %pushi @item %push
- %pushl, %pushl:0:0, %pushl:0:1, %pushl:0:2, %pushl:0:3 @item %pushi
- %pushe, %pushe:0:0, %pushe:0:1, %pushe:0:2, %pushe:0:3 @item %pushl, %pushl:0:0, %pushl:0:1, %pushl:0:2, %pushl:0:3
- %pusht @item %pushe, %pushe:0:0, %pushe:0:1, %pushe:0:2, %pushe:0:3
@item %pusht
@end itemize
- %loadi @itemize
- %loadl, %loadl:0:0, %loadl:0:1, %loadl:0:2, %loadl:0:3 @item %loadi
- %loade, %loade:0:0, %loade:0:1, %loade:0:2, %loade:0:3 @item %loadl, %loadl:0:0, %loadl:0:1, %loadl:0:2, %loadl:0:3
- %loadt @item %loade, %loade:0:0, %loade:0:1, %loade:0:2, %loade:0:3
@item %loadt
@end itemize
- %savei @itemize
- %savel, %savel:0:0, %savel:0:1, %savel:0:2, %savel:0:3 @item %savei
- %savee, %savee:0:0, %savee:0:1, %savee:0:2, %savee:0:3 @item %savel, %savel:0:0, %savel:0:1, %savel:0:2, %savel:0:3
- %savet @item %savee, %savee:0:0, %savee:0:1, %savee:0:2, %savee:0:3
@item %savet
@end itemize
** Flow control instructions @section Flow control instructions
- %br-if @itemize
- %br-if-not @item %br-if
- %jump @item %br-if-not
@item %jump
@end itemize
** Function call instructions @section Function call instructions
- %func, %func0, %func1, %func2 @itemize
@item %func, %func0, %func1, %func2
@end itemize
** Scheme buitin functions @section Scheme built-in functions
- cons @itemize
- car @item cons
- cdr @item car
@item cdr
@end itemize
** Mathematical buitin functions @section Mathematical buitin functions
- 1+ @itemize
- 1- @item 1+
- add, add2 @item 1-
- sub, sub2, minus @item add, add2
- mul2 @item sub, sub2, minus
- div2 @item mul2
- lt2 @item div2
- gt2 @item lt2
- le2 @item gt2
- ge2 @item le2
- num-eq2 @item ge2
@item num-eq2
@end itemize
@c ********************************************************************* @c *********************************************************************
@node Concept Index, Command Index, Related Information, Top @c @node Concept Index, Command Index, Related Information, Top
@unnumbered Concept Index @c @unnumbered Concept Index
@printindex cp @c @printindex cp
@node Command Index, Variable Index, Concept Index, Top @c @node Command Index, Variable Index, Concept Index, Top
@unnumbered Command Index @c @unnumbered Command Index
@printindex fn @c @printindex fn
@node Variable Index, , Command Index, Top @c @node Variable Index, , Command Index, Top
@unnumbered Variable Index @c @unnumbered Variable Index
@printindex vr @c @printindex vr
@bye @bye

26
module/system/vm/assemble.scm
View file

@ -77,6 +77,7 @@
(label-alist '()) (label-alist '())
(object-alist '())) (object-alist '()))
(define (push-code! code) (define (push-code! code)
(format #t "push-code! ~a~%" code)
(set! stack (cons (code->bytes code) stack))) (set! stack (cons (code->bytes code) stack)))
(define (push-object! x) (define (push-object! x)
(cond ((object->code x) => push-code!) (cond ((object->code x) => push-code!)
@ -90,7 +91,7 @@
(push-code! `(object-ref ,i)))))) (push-code! `(object-ref ,i))))))
(define (current-address) (define (current-address)
(define (byte-length x) (define (byte-length x)
(cond ((string? x) (u8vector-length x)) (cond ((u8vector? x) (u8vector-length x))
(else 3))) (else 3)))
(apply + (map byte-length stack))) (apply + (map byte-length stack)))
(define (generate-code x) (define (generate-code x)
@ -167,6 +168,7 @@
;; ;;
;; main ;; main
(for-each generate-code body) (for-each generate-code body)
(format #t "codegen: stack = ~a~%" (reverse stack))
(let ((bytes (stack->bytes (reverse! stack) label-alist))) (let ((bytes (stack->bytes (reverse! stack) label-alist)))
(if toplevel (if toplevel
(bytecode->objcode bytes vars.nlocs vars.nexts) (bytecode->objcode bytes vars.nlocs vars.nexts)
@ -211,18 +213,6 @@
;; NOTE: undumpped in vm_load.c. ;; NOTE: undumpped in vm_load.c.
(define (dump-object! push-code! x) (define (dump-object! push-code! x)
(define (symbol->u8vector sym)
(apply u8vector
(map char->integer
(string->list (symbol->string sym)))))
(define (number->u8vector num)
(apply u8vector
(map char->integer
(string->list (number->string num)))))
(define (string->u8vector str)
(apply u8vector
(map char->integer (string->list str))))
(let dump! ((x x)) (let dump! ((x x))
(cond (cond
((object->code x) => push-code!) ((object->code x) => push-code!)
@ -256,7 +246,7 @@
(push-code! `(load-program ,bytes))) (push-code! `(load-program ,bytes)))
(($ <vlink> module name) (($ <vlink> module name)
;; FIXME: dump module ;; FIXME: dump module
(push-code! `(link ,(symbol->u8vector name)))) (push-code! `(link ,(symbol->string name))))
(($ <vmod> id) (($ <vmod> id)
(push-code! `(load-module ,id))) (push-code! `(load-module ,id)))
((and ($ integer) ($ exact)) ((and ($ integer) ($ exact))
@ -266,14 +256,14 @@
(apply u8vector l))))) (apply u8vector l)))))
(push-code! `(load-integer ,str)))) (push-code! `(load-integer ,str))))
(($ number) (($ number)
(push-code! `(load-number ,(number->u8vector x)))) (push-code! `(load-number ,(number->string x))))
(($ string) (($ string)
(push-code! `(load-string ,(string->u8vector x)))) (push-code! `(load-string ,(string->string x))))
(($ symbol) (($ symbol)
(push-code! `(load-symbol ,(symbol->u8vector x)))) (push-code! `(load-symbol ,(symbol->string x))))
(($ keyword) (($ keyword)
(push-code! `(load-keyword (push-code! `(load-keyword
,(symbol->u8vector (keyword-dash-symbol x))))) ,(symbol->string (keyword-dash-symbol x)))))
(($ list) (($ list)
(for-each dump! x) (for-each dump! x)
(push-code! `(list ,(length x)))) (push-code! `(list ,(length x))))

32
module/system/vm/conv.scm
View file

@ -24,6 +24,7 @@
:use-module (ice-9 match) :use-module (ice-9 match)
:use-module (ice-9 regex) :use-module (ice-9 regex)
:use-module (srfi srfi-4) :use-module (srfi srfi-4)
:use-module (srfi srfi-1)
:export (code-pack code-unpack object->code code->object code->bytes :export (code-pack code-unpack object->code code->object code->bytes
make-byte-decoder)) make-byte-decoder))
@ -86,7 +87,18 @@
(('load-keyword s) (make-keyword-from-dash-symbol (string->symbol s))) (('load-keyword s) (make-keyword-from-dash-symbol (string->symbol s)))
(else #f))) (else #f)))
; (let ((c->o code->object))
; (set! code->object
; (lambda (code)
; (format #t "code->object: ~a~%" code)
; (let ((ret (c->o code)))
; (format #t "code->object returned ~a~%" ret)
; ret))))
(define (code->bytes code) (define (code->bytes code)
(define (string->u8vector str)
(apply u8vector (map char->integer (string->list str))))
(let* ((code (code-pack code)) (let* ((code (code-pack code))
(inst (car code)) (inst (car code))
(rest (cdr code)) (rest (cdr code))
@ -95,6 +107,8 @@
(cond ((< len 0) (cond ((< len 0)
;; Variable-length code ;; Variable-length code
;; Typical instructions are `link' and `load-program'. ;; Typical instructions are `link' and `load-program'.
(if (string? (car rest))
(set-car! rest (string->u8vector (car rest))))
(let* ((str (car rest)) (let* ((str (car rest))
(str-len (u8vector-length str)) (str-len (u8vector-length str))
(encoded-len (encode-length str-len)) (encoded-len (encode-length str-len))
@ -121,9 +135,11 @@
(define (make-byte-decoder bytes) (define (make-byte-decoder bytes)
(let ((addr 0) (size (u8vector-length bytes))) (let ((addr 0) (size (u8vector-length bytes)))
(define (pop) (define (pop)
(let ((byte (char->integer (u8vector-ref bytes addr)))) (let ((byte (u8vector-ref bytes addr)))
(set! addr (1+ addr)) (set! addr (1+ addr))
byte)) byte))
(define (sublist lst start end)
(take (drop lst start) (- end start)))
(lambda () (lambda ()
(if (< addr size) (if (< addr size)
(let* ((start addr) (let* ((start addr)
@ -132,12 +148,16 @@
(code (if (< n 0) (code (if (< n 0)
;; variable length ;; variable length
(let* ((end (+ (decode-length pop) addr)) (let* ((end (+ (decode-length pop) addr))
(str (apply u8vector (subbytes (sublist
(list-tail (u8vector->list (u8vector->list bytes)
bytes) addr end))
addr)))) (->string? (not (eq? inst 'load-program))))
(set! addr end) (set! addr end)
(list inst str)) (list inst
(if ->string?
(list->string
(map integer->char subbytes))
(apply u8vector subbytes))))
;; fixed length ;; fixed length
(do ((n n (1- n)) (do ((n n (1- n))
(l '() (cons (pop) l))) (l '() (cons (pop) l)))

11
module/system/vm/disasm.scm
View file

@ -27,7 +27,7 @@
:use-module (ice-9 format) :use-module (ice-9 format)
:use-module (ice-9 receive) :use-module (ice-9 receive)
:use-module (ice-9 and-let-star) :use-module (ice-9 and-let-star)
:export (disassemble-objcode disassemble-program)) :export (disassemble-objcode disassemble-program disassemble-bytecode))
(define (disassemble-objcode objcode . opts) (define (disassemble-objcode objcode . opts)
(let* ((prog (objcode->program objcode)) (let* ((prog (objcode->program objcode))
@ -129,6 +129,15 @@
(define (list->info list) (define (list->info list)
(object->string list)) (object->string list))
; (define (u8vector->string vec)
; (list->string (map integer->char (u8vector->list vec))))
; (case (car list)
; ((link)
; (object->string `(link ,(u8vector->string (cadr list)))))
; (else
; (object->string list))))
(define (print-info addr info extra) (define (print-info addr info extra)
(if extra (if extra
(format #t "~4@A ~32A;; ~A\n" addr info extra) (format #t "~4@A ~32A;; ~A\n" addr info extra)

4
src/instructions.c
View file

@ -87,7 +87,7 @@ SCM_DEFINE (scm_instruction_list, "instruction-list", 0, 0, 0,
SCM list = SCM_EOL; SCM list = SCM_EOL;
struct scm_instruction *ip; struct scm_instruction *ip;
for (ip = scm_instruction_table; ip->opcode != scm_op_last; ip++) for (ip = scm_instruction_table; ip->opcode != scm_op_last; ip++)
list = scm_cons (scm_str2symbol (ip->name), list); list = scm_cons (scm_from_locale_symbol (ip->name), list);
return scm_reverse_x (list, SCM_EOL); return scm_reverse_x (list, SCM_EOL);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -150,7 +150,7 @@ SCM_DEFINE (scm_opcode_to_instruction, "opcode->instruction", 1, 0, 0,
SCM_VALIDATE_INUM (1, op); SCM_VALIDATE_INUM (1, op);
i = scm_to_int (op); i = scm_to_int (op);
SCM_ASSERT_RANGE (1, op, 0 <= i && i < scm_op_last); SCM_ASSERT_RANGE (1, op, 0 <= i && i < scm_op_last);
return scm_str2symbol (scm_instruction_table[i].name); return scm_from_locale_symbol (scm_instruction_table[i].name);
} }
#undef FUNC_NAME #undef FUNC_NAME

2
src/objcodes.c
View file

@ -153,6 +153,8 @@ SCM_DEFINE (scm_bytecode_to_objcode, "bytecode->objcode", 3, 0, 0,
c_bytecode = scm_u8vector_elements (bytecode, &handle, &size, &increment); c_bytecode = scm_u8vector_elements (bytecode, &handle, &size, &increment);
assert (increment == 1); assert (increment == 1);
/* Account for the 10 byte-long header. */
size += 10;
objcode = make_objcode (size); objcode = make_objcode (size);
base = SCM_OBJCODE_BASE (objcode); base = SCM_OBJCODE_BASE (objcode);

17
src/programs.c
View file

@ -188,15 +188,26 @@ SCM_DEFINE (scm_program_external, "program-external", 1, 0, 0,
SCM_DEFINE (scm_program_bytecode, "program-bytecode", 1, 0, 0, SCM_DEFINE (scm_program_bytecode, "program-bytecode", 1, 0, 0,
(SCM program), (SCM program),
"") "Return a u8vector containing @var{program}'s bytecode.")
#define FUNC_NAME s_scm_program_bytecode #define FUNC_NAME s_scm_program_bytecode
{ {
size_t size;
char *c_bytecode;
SCM_VALIDATE_PROGRAM (1, program); SCM_VALIDATE_PROGRAM (1, program);
return scm_makfromstr (SCM_PROGRAM_DATA (program)->base,
SCM_PROGRAM_DATA (program)->size, 0); size = SCM_PROGRAM_DATA (program)->size;
c_bytecode = malloc (size);
if (!c_bytecode)
return SCM_BOOL_F;
memcpy (c_bytecode, SCM_PROGRAM_DATA (program)->base, size);
return scm_take_u8vector (c_bytecode, size);
} }
#undef FUNC_NAME #undef FUNC_NAME
void void
scm_init_programs (void) scm_init_programs (void)

2
src/vm.c
View file

@ -301,7 +301,7 @@ SCM_DEFINE (scm_vm_version, "vm-version", 0, 0, 0,
"") "")
#define FUNC_NAME s_scm_vm_version #define FUNC_NAME s_scm_vm_version
{ {
return scm_makfrom0str (VERSION); return scm_from_locale_string (VERSION);
} }
#undef FUNC_NAME #undef FUNC_NAME

16
src/vm_engine.c
View file

@ -123,44 +123,44 @@ vm_run (SCM vm, SCM program, SCM args)
/* Errors */ /* Errors */
{ {
vm_error_unbound: vm_error_unbound:
err_msg = scm_makfrom0str ("VM: Unbound variable: ~A"); err_msg = scm_from_locale_string ("VM: Unbound variable: ~A");
goto vm_error; goto vm_error;
vm_error_wrong_type_arg: vm_error_wrong_type_arg:
err_msg = scm_makfrom0str ("VM: Wrong type argument"); err_msg = scm_from_locale_string ("VM: Wrong type argument");
err_args = SCM_EOL; err_args = SCM_EOL;
goto vm_error; goto vm_error;
vm_error_wrong_num_args: vm_error_wrong_num_args:
err_msg = scm_makfrom0str ("VM: Wrong number of arguments"); err_msg = scm_from_locale_string ("VM: Wrong number of arguments");
err_args = SCM_EOL; err_args = SCM_EOL;
goto vm_error; goto vm_error;
vm_error_wrong_type_apply: vm_error_wrong_type_apply:
err_msg = scm_makfrom0str ("VM: Wrong type to apply: ~S"); err_msg = scm_from_locale_string ("VM: Wrong type to apply: ~S");
err_args = SCM_LIST1 (program); err_args = SCM_LIST1 (program);
goto vm_error; goto vm_error;
vm_error_stack_overflow: vm_error_stack_overflow:
err_msg = scm_makfrom0str ("VM: Stack overflow"); err_msg = scm_from_locale_string ("VM: Stack overflow");
err_args = SCM_EOL; err_args = SCM_EOL;
goto vm_error; goto vm_error;
vm_error_stack_underflow: vm_error_stack_underflow:
err_msg = scm_makfrom0str ("VM: Stack underflow"); err_msg = scm_from_locale_string ("VM: Stack underflow");
err_args = SCM_EOL; err_args = SCM_EOL;
goto vm_error; goto vm_error;
#if VM_CHECK_IP #if VM_CHECK_IP
vm_error_invalid_address: vm_error_invalid_address:
err_msg = scm_makfrom0str ("VM: Invalid program address"); err_msg = scm_from_locale_string ("VM: Invalid program address");
err_args = SCM_EOL; err_args = SCM_EOL;
goto vm_error; goto vm_error;
#endif #endif
#if VM_CHECK_EXTERNAL #if VM_CHECK_EXTERNAL
vm_error_external: vm_error_external:
err_msg = scm_makfrom0str ("VM: Invalid external access"); err_msg = scm_from_locale_string ("VM: Invalid external access");
err_args = SCM_EOL; err_args = SCM_EOL;
goto vm_error; goto vm_error;
#endif #endif